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 capaci