From gitlab at gitlab.haskell.org Mon Apr 1 00:03:55 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 31 Mar 2024 20:03:55 -0400 Subject: [Git][ghc/ghc][master] EPA: Extend StringLiteral range to include trailing commas Message-ID: <6609f9ebe9a10_23d1488b27482416a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 00d3ecf0 by Alan Zimmerman at 2024-03-29T12:19:10+00:00 EPA: Extend StringLiteral range to include trailing commas This goes slightly against the exact printing philosophy where trailing decorations should be in an annotation, but the practicalities of adding it to the WarningTxt environment, and the problems caused by deviating do not make a more principles approach worthwhile. - - - - - 2 changed files: - compiler/GHC/Parser.y - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -4559,7 +4559,8 @@ addTrailingCommaN (L anns a) span = do return (L anns' a) addTrailingCommaS :: Located StringLiteral -> EpaLocation -> Located StringLiteral -addTrailingCommaS (L l sl) span = L l (sl { sl_tc = Just (epaLocationRealSrcSpan span) }) +addTrailingCommaS (L l sl) span + = L (widenSpan l [AddEpAnn AnnComma span]) (sl { sl_tc = Just (epaLocationRealSrcSpan span) }) -- ------------------------------------- ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -652,6 +652,10 @@ printSourceText :: (Monad m, Monoid w) => SourceText -> String -> EP w m () printSourceText (NoSourceText) txt = printStringAdvance txt >> return () printSourceText (SourceText txt) _ = printStringAdvance (unpackFS txt) >> return () +printSourceTextAA :: (Monad m, Monoid w) => SourceText -> String -> EP w m () +printSourceTextAA (NoSourceText) txt = printStringAtAA (EpaDelta (SameLine 0) []) txt >> return () +printSourceTextAA (SourceText txt) _ = printStringAtAA (EpaDelta (SameLine 0) []) (unpackFS txt) >> return () + -- --------------------------------------------------------------------- printStringAtSs :: (Monad m, Monoid w) => SrcSpan -> String -> EP w m () @@ -2099,7 +2103,7 @@ instance ExactPrint StringLiteral where setAnnotationAnchor a _ _ _ = a exact l@(StringLiteral src fs mcomma) = do - printSourceText src (show (unpackFS fs)) + printSourceTextAA src (show (unpackFS fs)) mapM_ (\r -> printStringAtRs r ",") mcomma return l View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00d3ecf0775c1a3f1ab8495e5e125f21d450394e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00d3ecf0775c1a3f1ab8495e5e125f21d450394e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 00:04:36 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 31 Mar 2024 20:04:36 -0400 Subject: [Git][ghc/ghc][master] clarify Note [Preproccesing invocations] Message-ID: <6609fa1471933_23d148a7cab0272d8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - 1 changed file: - compiler/GHC/SysTools/Cpp.hs Changes: ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -63,7 +63,22 @@ underlying program (the C compiler), the set of flags passed determines the behaviour of the preprocessor, and Cpp and HsCpp behave differently. Specifically, we rely on "traditional" (pre-standard) preprocessing semantics (which most compilers expose via the `-traditional` flag) when preprocessing -Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +Haskell source. This avoids the following situations: + + * Removal of C-style comments, which are not comments in Haskell but valid + operators; + + * Errors due to an ANSI C preprocessor lexing the source and failing on + names with single quotes (TH quotes, ticked promoted constructors, + names with primes in them). + + Both of those cases may be subtle: gcc and clang permit C++-style // + comments in C code, and Data.Array and Data.Vector both export a // + operator whose type is such that a removed "comment" may leave code that + typechecks but does the wrong thing. Another example is that, since ANSI + C permits long character constants, an expression involving multiple + functions with primes in their names may not expand macros properly when + they occur between the primed functions. -} -- | Run either the Haskell preprocessor or the C preprocessor, as per the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/efab3649b685d92b1856a62532b343ef70777612 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/efab3649b685d92b1856a62532b343ef70777612 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 01:26:40 2024 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Sun, 31 Mar 2024 21:26:40 -0400 Subject: [Git][ghc/ghc][wip/T23490-part2] Try replacing "req_th" with "req_interp" for T11462, T11525 Message-ID: <660a0d50a8a8c_23d1481488478303fb@gitlab.mail> Matthew Craven pushed to branch wip/T23490-part2 at Glasgow Haskell Compiler / GHC Commits: 45062519 by Matthew Craven at 2024-03-31T21:24:13-04:00 Try replacing "req_th" with "req_interp" for T11462, T11525 (A guess based on the test options used in the main plugins testdir.) - - - - - 1 changed file: - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -491,7 +491,7 @@ test('T10592', normal, compile, ['']) test('T11305', normal, compile, ['']) test('T11254', normal, compile, ['']) test('T11379', normal, compile, ['']) -test('T11462', [js_broken(22261), req_th], multi_compile, +test('T11462', [js_broken(22261), req_interp], multi_compile, [None, [('T11462_Plugin.hs', '-package ghc'), ('T11462.hs', '')], '-dynamic' if have_dynamic() else '']) test('T11480', normal, compile, ['']) @@ -559,7 +559,7 @@ test('T11723', normal, compile, ['']) test('T12987', normal, compile, ['']) test('T11736', normal, compile, ['']) test('T13248', expect_broken(13248), compile, ['']) -test('T11525', [js_broken(22261), req_th], multi_compile, +test('T11525', [js_broken(22261), req_interp], multi_compile, [None, [('T11525_Plugin.hs', '-package ghc'), ('T11525.hs', '')], '-dynamic' if have_dynamic() else '']) test('T12923_1', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4506251910cbc38296d9c014b4942fae18ff301b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4506251910cbc38296d9c014b4942fae18ff301b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 07:28:01 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 01 Apr 2024 03:28:01 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T24463 Message-ID: <660a62018b3e5_23d1483c792205255f@gitlab.mail> Simon Peyton Jones pushed new branch wip/T24463 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T24463 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 08:38:30 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 01 Apr 2024 04:38:30 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 14 commits: EPA: Extend StringLiteral range to include trailing commas Message-ID: <660a7286707c2_174ee1282850795cb@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 00d3ecf0 by Alan Zimmerman at 2024-03-29T12:19:10+00:00 EPA: Extend StringLiteral range to include trailing commas This goes slightly against the exact printing philosophy where trailing decorations should be in an annotation, but the practicalities of adding it to the WarningTxt environment, and the problems caused by deviating do not make a more principles approach worthwhile. - - - - - efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - ac55fe7a by Simon Peyton Jones at 2024-04-01T09:37:28+01:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 3e4ac7b3 by Simon Peyton Jones at 2024-04-01T09:37:28+01:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - f1b36c74 by Simon Peyton Jones at 2024-04-01T09:37:28+01:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 346a21f7 by Simon Peyton Jones at 2024-04-01T09:37:29+01:00 Spelling, layout, pretty-printing only - - - - - fae6aa6a by Simon Peyton Jones at 2024-04-01T09:37:29+01:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 84236391 by Simon Peyton Jones at 2024-04-01T09:37:29+01:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - 8e4bc1d5 by Simon Peyton Jones at 2024-04-01T09:37:29+01:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - 54c038a8 by Simon Peyton Jones at 2024-04-01T09:37:29+01:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - 42b4a18d by Simon Peyton Jones at 2024-04-01T09:37:29+01:00 Remove a long-commented-out line Pure refactoring - - - - - af913d6a by Simon Peyton Jones at 2024-04-01T09:37:32+01:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.1% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -4.0% PmSeriesV(normal) -1.7% T11195(normal) -1.3% T12227(normal) -20.5% GOOD T12545(normal) -3.2% T12707(normal) -2.2% GOOD T13253(normal) -1.5% T13253-spj(normal) +8.1% BAD T13386(normal) -3.0% GOOD T14766(normal) -2.7% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15703(normal) -14.8% GOOD T16577(normal) -2.3% GOOD T16875(normal) -0.1% T17516(normal) -39.7% GOOD T18140(normal) +1.1% T18223(normal) -17.2% GOOD T18282(normal) -5.1% GOOD T18304(normal) +10.8% BAD T18923(normal) -3.0% GOOD T19695(normal) -1.5% T20049(normal) -12.8% GOOD T21839c(normal) -4.3% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.9% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.8% GOOD T9961(normal) +1.8% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.4% parsing001(normal) +1.4% geo. mean -2.1% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T3294 T9961 - - - - - 616c0d4a by Simon Peyton Jones at 2024-04-01T09:38:19+01:00 Testsuite message changes from simplifier improvements - - - - - c556cf6d by Simon Peyton Jones at 2024-04-01T09:38:20+01:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 14 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6483e76a896546107d6323c9d43d9c63af3bf08b...c556cf6d71e096eb62851503fc04266d1e32895b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6483e76a896546107d6323c9d43d9c63af3bf08b...c556cf6d71e096eb62851503fc04266d1e32895b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 09:24:10 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 Apr 2024 05:24:10 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 13 commits: EPA: Fix FamDecl range Message-ID: <660a7d3ab6f7b_174ee18f751487683@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: cd0fb82f by Alan Zimmerman at 2024-03-27T19:33:08+00:00 EPA: Fix FamDecl range The span was incorrect if opt_datafam_kind_sig was empty - - - - - f8f384a8 by Ben Gamari at 2024-03-29T01:23:03-04:00 Fix type of _get_osfhandle foreign import Fixes #24601. - - - - - 00d3ecf0 by Alan Zimmerman at 2024-03-29T12:19:10+00:00 EPA: Extend StringLiteral range to include trailing commas This goes slightly against the exact printing philosophy where trailing decorations should be in an annotation, but the practicalities of adding it to the WarningTxt environment, and the problems caused by deviating do not make a more principles approach worthwhile. - - - - - efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - aa7f3683 by Rodrigo Mesquita at 2024-04-01T10:24:00+01:00 loader: Note down suggestion for needed_mods The associated ticket is #24600 - - - - - 83dad9ba by Rodrigo Mesquita at 2024-04-01T10:24:00+01:00 rts: free error message before returning Fixes a memory leak in rts/linker/PEi386.c - - - - - ea6384ca by Rodrigo Mesquita at 2024-04-01T10:24:00+01:00 Start writing test - - - - - 4e9433f7 by Alexis King at 2024-04-01T10:24:00+01:00 linker: Avoid linear search when looking up Haskell symbols via dlsym Write Note [Looking up symbols in the relevant objects] Write Note [Symbols may not be found in pkgs_loaded] Use lookupHsSymbol for PrimOps too - - - - - f0b8606f by Rodrigo Mesquita at 2024-04-01T10:24:00+01:00 wip: make addDLL wrapper around loadNativeObj - - - - - 089d1983 by Alexis King at 2024-04-01T10:24:00+01:00 wip: use loadNativeObj to implement addDLL - - - - - cd8e1bca by Rodrigo Mesquita at 2024-04-01T10:24:00+01:00 Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex CPP Support loadNativeObj in MachO - - - - - 797b857c by Rodrigo Mesquita at 2024-04-01T10:24:00+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - a9e42fa9 by Rodrigo Mesquita at 2024-04-01T10:24:00+01:00 Implement lookupSymbolInDLL for ExternalInterp - - - - - 30 changed files: - + T23415/Makefile - + T23415/main.hs - + T23415/make_shared_libs.sh - + T23415/new-main.hs - + T23415/run_test.sh - compiler/GHC.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/MacOS.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - compiler/GHC/Runtime/Utils.hs - compiler/GHC/SysTools/Cpp.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/ObjLink.hs - libraries/ghci/GHCi/Run.hs - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/include/rts/Linker.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/linker/PEi386.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/573b9729cabfbbc4810ae894ec7a6932ab24dcd3...a9e42fa9107949fd33a9fa91ffcdfe5369c51656 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/573b9729cabfbbc4810ae894ec7a6932ab24dcd3...a9e42fa9107949fd33a9fa91ffcdfe5369c51656 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 10:20:06 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 Apr 2024 06:20:06 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 3 commits: Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex Message-ID: <660a8a562961e_174ee1f3e8dc90130@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 223a1536 by Rodrigo Mesquita at 2024-04-01T11:19:19+01:00 Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex CPP Support loadNativeObj in MachO - - - - - 22437881 by Rodrigo Mesquita at 2024-04-01T11:19:19+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - fdf78387 by Rodrigo Mesquita at 2024-04-01T11:19:19+01:00 Implement lookupSymbolInDLL for ExternalInterp - - - - - 12 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/rts.cabal Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = putMVar (interpLookupSymbolCache interp) emptyUFM -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInDLL) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -419,9 +423,6 @@ static int linker_init_done = 0 ; static void *dl_prog_handle; static regex_t re_invalid; static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -578,8 +573,8 @@ static void * internal_dlsym(const char *symbol) { void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -587,7 +582,6 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } @@ -597,12 +591,10 @@ internal_dlsym(const char *symbol) { v = dlsym(nc->dlopen_handle, symbol); if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -645,14 +637,13 @@ internal_dlsym(const char *symbol) { void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { + ASSERT_LOCK_HELD(&linker_mutex); + #if defined(OBJFORMAT_MACHO) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif - - ACQUIRE_LOCK(&dl_mutex); // dlsym alters dlerror void *result = dlsym(handle, symbol_name); - RELEASE_LOCK(&dl_mutex); return result; } # endif @@ -1101,9 +1092,10 @@ void freeObjectCode (ObjectCode *oc) if (oc->type == DYNAMIC_OBJECT) { #if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); + // ROMES:TODO: This previously acquired dl_mutex. Check that acquiring linker_mutex here is fine. + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1868,73 +1860,20 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); + void *r = loadNativeObj_POSIX(path, errmsg); - if (r) { - RELEASE_LOCK(&linker_mutex); - return r; - } - - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - -#define NMATCH 5 - regmatch_t match[NMATCH]; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); - result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (*errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - RELEASE_LOCK(&linker_mutex); - // return original error if open fails - return NULL; - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)*errmsg); // Free old message before creating new one - r = loadNativeObj_ELF(line+match[2].rm_so, errmsg); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); } +#endif RELEASE_LOCK(&linker_mutex); return r; @@ -1982,7 +1921,7 @@ static HsInt unloadNativeObj_(void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ ===================================== rts/linker/Elf.c ===================================== @@ -32,6 +32,8 @@ #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,191 +2071,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - - /* If we load the same object multiple times, just return the - * already-loaded handle. Note that this is broken if unloadNativeObj - * is used, as we don’t do any reference counting; see #24345. - */ - ObjectCode *existing_oc = lookupObjectByPath(path); - if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { - if (existing_oc->type == DYNAMIC_OBJECT) { - retval = existing_oc->dlopen_handle; - goto success; - } - copyErrmsg(errmsg, "loadNativeObj_ELF: already loaded as non-dynamic object"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - // We want to use RTLD_NOW rather than RTLD_LAZY because in the case that - // DLINFO is available we want to learn eagerly about all symbols, however, - // there is no ldinfo on macos in which case we prefer using RTLD_LAZY. - // ROMES:TODO: ^ - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - nc->dlopen_handle = hdl; - nc->status = OBJECT_READY; - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - foreignExportsFinishedLoadingObject(); - - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2303,4 +2120,70 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex) + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + // ROMES:TODO: NO GOOD, this is almost recursive? no, as long we + // move the loadNativeObj_ELF to a shared impl + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,211 @@ +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "LinkerInternals.h" +#include "Rts.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + + ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9e42fa9107949fd33a9fa91ffcdfe5369c51656...fdf783879bf9acc7af10e5c56b9cf84185e933fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9e42fa9107949fd33a9fa91ffcdfe5369c51656...fdf783879bf9acc7af10e5c56b9cf84185e933fb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 10:33:09 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 Apr 2024 06:33:09 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 3 commits: Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex Message-ID: <660a8d6526719_174ee111887789347f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 96457f26 by Rodrigo Mesquita at 2024-04-01T11:32:51+01:00 Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex CPP Support loadNativeObj in MachO - - - - - 6d4f7cb7 by Rodrigo Mesquita at 2024-04-01T11:32:51+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - eb6a101f by Rodrigo Mesquita at 2024-04-01T11:32:51+01:00 Implement lookupSymbolInDLL for ExternalInterp - - - - - 12 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/rts.cabal Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = putMVar (interpLookupSymbolCache interp) emptyUFM -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInDLL) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -419,9 +423,6 @@ static int linker_init_done = 0 ; static void *dl_prog_handle; static regex_t re_invalid; static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -578,8 +573,8 @@ static void * internal_dlsym(const char *symbol) { void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -587,7 +582,6 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } @@ -597,12 +591,10 @@ internal_dlsym(const char *symbol) { v = dlsym(nc->dlopen_handle, symbol); if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -645,14 +637,13 @@ internal_dlsym(const char *symbol) { void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { + ASSERT_LOCK_HELD(&linker_mutex); + #if defined(OBJFORMAT_MACHO) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif - - ACQUIRE_LOCK(&dl_mutex); // dlsym alters dlerror void *result = dlsym(handle, symbol_name); - RELEASE_LOCK(&dl_mutex); return result; } # endif @@ -1101,9 +1092,10 @@ void freeObjectCode (ObjectCode *oc) if (oc->type == DYNAMIC_OBJECT) { #if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); + // ROMES:TODO: This previously acquired dl_mutex. Check that acquiring linker_mutex here is fine. + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1868,73 +1860,20 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); + void *r = loadNativeObj_POSIX(path, errmsg); - if (r) { - RELEASE_LOCK(&linker_mutex); - return r; - } - - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - -#define NMATCH 5 - regmatch_t match[NMATCH]; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); - result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (*errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - RELEASE_LOCK(&linker_mutex); - // return original error if open fails - return NULL; - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)*errmsg); // Free old message before creating new one - r = loadNativeObj_ELF(line+match[2].rm_so, errmsg); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); } +#endif RELEASE_LOCK(&linker_mutex); return r; @@ -1982,7 +1921,7 @@ static HsInt unloadNativeObj_(void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ ===================================== rts/linker/Elf.c ===================================== @@ -1,4 +1,5 @@ #include "Rts.h" +#include "rts/PosixSource.h" #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) \ || defined(linux_android_HOST_OS) \ @@ -28,10 +29,13 @@ #include "linker/util.h" #include "linker/elf_util.h" +#include #include #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,191 +2073,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - - /* If we load the same object multiple times, just return the - * already-loaded handle. Note that this is broken if unloadNativeObj - * is used, as we don’t do any reference counting; see #24345. - */ - ObjectCode *existing_oc = lookupObjectByPath(path); - if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { - if (existing_oc->type == DYNAMIC_OBJECT) { - retval = existing_oc->dlopen_handle; - goto success; - } - copyErrmsg(errmsg, "loadNativeObj_ELF: already loaded as non-dynamic object"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - // We want to use RTLD_NOW rather than RTLD_LAZY because in the case that - // DLINFO is available we want to learn eagerly about all symbols, however, - // there is no ldinfo on macos in which case we prefer using RTLD_LAZY. - // ROMES:TODO: ^ - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - nc->dlopen_handle = hdl; - nc->status = OBJECT_READY; - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - foreignExportsFinishedLoadingObject(); - - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2303,4 +2122,73 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +extern regex_t re_invalid; +extern regex_t re_realso; + +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex) + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + // ROMES:TODO: NO GOOD, this is almost recursive? no, as long we + // move the loadNativeObj_ELF to a shared impl + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,211 @@ +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "LinkerInternals.h" +#include "Rts.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + + ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdf783879bf9acc7af10e5c56b9cf84185e933fb...eb6a101f293d4d2cfb976a1a37cb32b32722f26e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdf783879bf9acc7af10e5c56b9cf84185e933fb...eb6a101f293d4d2cfb976a1a37cb32b32722f26e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 10:33:56 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 Apr 2024 06:33:56 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 3 commits: Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex Message-ID: <660a8d948dad0_174ee1127c5d093749@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 4381c150 by Rodrigo Mesquita at 2024-04-01T11:33:40+01:00 Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex CPP Support loadNativeObj in MachO - - - - - 7fa524ab by Rodrigo Mesquita at 2024-04-01T11:33:40+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - ab309fc8 by Rodrigo Mesquita at 2024-04-01T11:33:40+01:00 Implement lookupSymbolInDLL for ExternalInterp - - - - - 12 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/rts.cabal Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = putMVar (interpLookupSymbolCache interp) emptyUFM -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInDLL) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -419,9 +423,6 @@ static int linker_init_done = 0 ; static void *dl_prog_handle; static regex_t re_invalid; static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -578,8 +573,8 @@ static void * internal_dlsym(const char *symbol) { void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -587,7 +582,6 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } @@ -597,12 +591,10 @@ internal_dlsym(const char *symbol) { v = dlsym(nc->dlopen_handle, symbol); if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -645,14 +637,13 @@ internal_dlsym(const char *symbol) { void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { + ASSERT_LOCK_HELD(&linker_mutex); + #if defined(OBJFORMAT_MACHO) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif - - ACQUIRE_LOCK(&dl_mutex); // dlsym alters dlerror void *result = dlsym(handle, symbol_name); - RELEASE_LOCK(&dl_mutex); return result; } # endif @@ -1101,9 +1092,10 @@ void freeObjectCode (ObjectCode *oc) if (oc->type == DYNAMIC_OBJECT) { #if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); + // ROMES:TODO: This previously acquired dl_mutex. Check that acquiring linker_mutex here is fine. + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1868,73 +1860,20 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); + void *r = loadNativeObj_POSIX(path, errmsg); - if (r) { - RELEASE_LOCK(&linker_mutex); - return r; - } - - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - -#define NMATCH 5 - regmatch_t match[NMATCH]; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); - result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (*errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - RELEASE_LOCK(&linker_mutex); - // return original error if open fails - return NULL; - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)*errmsg); // Free old message before creating new one - r = loadNativeObj_ELF(line+match[2].rm_so, errmsg); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); } +#endif RELEASE_LOCK(&linker_mutex); return r; @@ -1982,7 +1921,7 @@ static HsInt unloadNativeObj_(void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ ===================================== rts/linker/Elf.c ===================================== @@ -28,10 +28,13 @@ #include "linker/util.h" #include "linker/elf_util.h" +#include #include #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,191 +2072,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - - /* If we load the same object multiple times, just return the - * already-loaded handle. Note that this is broken if unloadNativeObj - * is used, as we don’t do any reference counting; see #24345. - */ - ObjectCode *existing_oc = lookupObjectByPath(path); - if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { - if (existing_oc->type == DYNAMIC_OBJECT) { - retval = existing_oc->dlopen_handle; - goto success; - } - copyErrmsg(errmsg, "loadNativeObj_ELF: already loaded as non-dynamic object"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - // We want to use RTLD_NOW rather than RTLD_LAZY because in the case that - // DLINFO is available we want to learn eagerly about all symbols, however, - // there is no ldinfo on macos in which case we prefer using RTLD_LAZY. - // ROMES:TODO: ^ - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - nc->dlopen_handle = hdl; - nc->status = OBJECT_READY; - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - foreignExportsFinishedLoadingObject(); - - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2303,4 +2121,73 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +extern regex_t re_invalid; +extern regex_t re_realso; + +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex) + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + // ROMES:TODO: NO GOOD, this is almost recursive? no, as long we + // move the loadNativeObj_ELF to a shared impl + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,211 @@ +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "LinkerInternals.h" +#include "Rts.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + + ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb6a101f293d4d2cfb976a1a37cb32b32722f26e...ab309fc8032173bcfa993778a0cc73e0a34e641b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb6a101f293d4d2cfb976a1a37cb32b32722f26e...ab309fc8032173bcfa993778a0cc73e0a34e641b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 10:38:03 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 Apr 2024 06:38:03 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 3 commits: Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex Message-ID: <660a8e8b4822d_174ee113a45709403d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 78684d22 by Rodrigo Mesquita at 2024-04-01T11:37:46+01:00 Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex CPP Support loadNativeObj in MachO - - - - - 6af9ab1c by Rodrigo Mesquita at 2024-04-01T11:37:46+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 5d3fbb9f by Rodrigo Mesquita at 2024-04-01T11:37:46+01:00 Implement lookupSymbolInDLL for ExternalInterp - - - - - 12 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/rts.cabal Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = putMVar (interpLookupSymbolCache interp) emptyUFM -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInDLL) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -419,9 +423,6 @@ static int linker_init_done = 0 ; static void *dl_prog_handle; static regex_t re_invalid; static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -578,8 +573,8 @@ static void * internal_dlsym(const char *symbol) { void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -587,7 +582,6 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } @@ -597,12 +591,10 @@ internal_dlsym(const char *symbol) { v = dlsym(nc->dlopen_handle, symbol); if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -645,14 +637,13 @@ internal_dlsym(const char *symbol) { void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { + ASSERT_LOCK_HELD(&linker_mutex); + #if defined(OBJFORMAT_MACHO) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif - - ACQUIRE_LOCK(&dl_mutex); // dlsym alters dlerror void *result = dlsym(handle, symbol_name); - RELEASE_LOCK(&dl_mutex); return result; } # endif @@ -1101,9 +1092,10 @@ void freeObjectCode (ObjectCode *oc) if (oc->type == DYNAMIC_OBJECT) { #if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); + // ROMES:TODO: This previously acquired dl_mutex. Check that acquiring linker_mutex here is fine. + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1868,73 +1860,20 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); + void *r = loadNativeObj_POSIX(path, errmsg); - if (r) { - RELEASE_LOCK(&linker_mutex); - return r; - } - - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - -#define NMATCH 5 - regmatch_t match[NMATCH]; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); - result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (*errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - RELEASE_LOCK(&linker_mutex); - // return original error if open fails - return NULL; - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)*errmsg); // Free old message before creating new one - r = loadNativeObj_ELF(line+match[2].rm_so, errmsg); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); } +#endif RELEASE_LOCK(&linker_mutex); return r; @@ -1982,7 +1921,7 @@ static HsInt unloadNativeObj_(void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ ===================================== rts/linker/Elf.c ===================================== @@ -27,11 +27,15 @@ #include "sm/OSMem.h" #include "linker/util.h" #include "linker/elf_util.h" +#include "linker/LoadNativeObjPosix.h" +#include #include #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,191 +2073,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - - /* If we load the same object multiple times, just return the - * already-loaded handle. Note that this is broken if unloadNativeObj - * is used, as we don’t do any reference counting; see #24345. - */ - ObjectCode *existing_oc = lookupObjectByPath(path); - if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { - if (existing_oc->type == DYNAMIC_OBJECT) { - retval = existing_oc->dlopen_handle; - goto success; - } - copyErrmsg(errmsg, "loadNativeObj_ELF: already loaded as non-dynamic object"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - // We want to use RTLD_NOW rather than RTLD_LAZY because in the case that - // DLINFO is available we want to learn eagerly about all symbols, however, - // there is no ldinfo on macos in which case we prefer using RTLD_LAZY. - // ROMES:TODO: ^ - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - nc->dlopen_handle = hdl; - nc->status = OBJECT_READY; - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - foreignExportsFinishedLoadingObject(); - - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2303,4 +2122,73 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +extern regex_t re_invalid; +extern regex_t re_realso; + +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex); + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + // ROMES:TODO: NO GOOD, this is almost recursive? no, as long we + // move the loadNativeObj_ELF to a shared impl + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,211 @@ +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "LinkerInternals.h" +#include "Rts.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + + ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab309fc8032173bcfa993778a0cc73e0a34e641b...5d3fbb9f2d132e1a30f0c37f8af4f42b8c95e201 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab309fc8032173bcfa993778a0cc73e0a34e641b...5d3fbb9f2d132e1a30f0c37f8af4f42b8c95e201 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 10:57:57 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 Apr 2024 06:57:57 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 3 commits: Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex Message-ID: <660a9335c3e4_174ee1162a5c496539@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 2064e541 by Rodrigo Mesquita at 2024-04-01T11:57:38+01:00 Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex CPP Support loadNativeObj in MachO - - - - - 181ae677 by Rodrigo Mesquita at 2024-04-01T11:57:38+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 09389a68 by Rodrigo Mesquita at 2024-04-01T11:57:38+01:00 Implement lookupSymbolInDLL for ExternalInterp - - - - - 12 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/rts.cabal Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = putMVar (interpLookupSymbolCache interp) emptyUFM -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInDLL) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -419,9 +423,6 @@ static int linker_init_done = 0 ; static void *dl_prog_handle; static regex_t re_invalid; static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -578,8 +573,8 @@ static void * internal_dlsym(const char *symbol) { void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -587,7 +582,6 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } @@ -597,12 +591,10 @@ internal_dlsym(const char *symbol) { v = dlsym(nc->dlopen_handle, symbol); if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -645,14 +637,13 @@ internal_dlsym(const char *symbol) { void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { + ASSERT_LOCK_HELD(&linker_mutex); + #if defined(OBJFORMAT_MACHO) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif - - ACQUIRE_LOCK(&dl_mutex); // dlsym alters dlerror void *result = dlsym(handle, symbol_name); - RELEASE_LOCK(&dl_mutex); return result; } # endif @@ -1101,9 +1092,10 @@ void freeObjectCode (ObjectCode *oc) if (oc->type == DYNAMIC_OBJECT) { #if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); + // ROMES:TODO: This previously acquired dl_mutex. Check that acquiring linker_mutex here is fine. + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1868,73 +1860,20 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); + void *r = loadNativeObj_POSIX(path, errmsg); - if (r) { - RELEASE_LOCK(&linker_mutex); - return r; - } - - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - -#define NMATCH 5 - regmatch_t match[NMATCH]; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); - result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (*errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - RELEASE_LOCK(&linker_mutex); - // return original error if open fails - return NULL; - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)*errmsg); // Free old message before creating new one - r = loadNativeObj_ELF(line+match[2].rm_so, errmsg); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); } +#endif RELEASE_LOCK(&linker_mutex); return r; @@ -1982,7 +1921,7 @@ static HsInt unloadNativeObj_(void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ @@ -451,6 +447,11 @@ typedef struct _RtsSymbolInfo { #include "BeginPrivate.h" +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +extern static regex_t re_invalid; +extern static regex_t re_realso; +#endif + void exitLinker( void ); void freeObjectCode (ObjectCode *oc); ===================================== rts/linker/Elf.c ===================================== @@ -27,11 +27,15 @@ #include "sm/OSMem.h" #include "linker/util.h" #include "linker/elf_util.h" +#include "linker/LoadNativeObjPosix.h" +#include #include #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,191 +2073,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - - /* If we load the same object multiple times, just return the - * already-loaded handle. Note that this is broken if unloadNativeObj - * is used, as we don’t do any reference counting; see #24345. - */ - ObjectCode *existing_oc = lookupObjectByPath(path); - if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { - if (existing_oc->type == DYNAMIC_OBJECT) { - retval = existing_oc->dlopen_handle; - goto success; - } - copyErrmsg(errmsg, "loadNativeObj_ELF: already loaded as non-dynamic object"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - // We want to use RTLD_NOW rather than RTLD_LAZY because in the case that - // DLINFO is available we want to learn eagerly about all symbols, however, - // there is no ldinfo on macos in which case we prefer using RTLD_LAZY. - // ROMES:TODO: ^ - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - nc->dlopen_handle = hdl; - nc->status = OBJECT_READY; - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - foreignExportsFinishedLoadingObject(); - - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2303,4 +2122,70 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex); + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + // ROMES:TODO: NO GOOD, this is almost recursive? no, as long we + // move the loadNativeObj_ELF to a shared impl + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,211 @@ +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "LinkerInternals.h" +#include "Rts.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + + ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d3fbb9f2d132e1a30f0c37f8af4f42b8c95e201...09389a68224b1c01da226ebeb2359194d96c4293 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d3fbb9f2d132e1a30f0c37f8af4f42b8c95e201...09389a68224b1c01da226ebeb2359194d96c4293 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 11:02:45 2024 From: gitlab at gitlab.haskell.org (Jade (@Jade)) Date: Mon, 01 Apr 2024 07:02:45 -0400 Subject: [Git][ghc/ghc][wip/three-way-merge-sort] WIP Message-ID: <660a9455673c0_174ee117796649681a@gitlab.mail> Jade pushed to branch wip/three-way-merge-sort at Glasgow Haskell Compiler / GHC Commits: 2459bcd9 by Jade at 2024-04-01T13:07:20+02:00 WIP - - - - - 1 changed file: - libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs ===================================== @@ -1645,15 +1645,8 @@ Further improved using a four-way merge, with an additional performance increase https://gitlab.haskell.org/ghc/ghc/issues/24280 -} -{-# INLINEABLE sort #-} -sort = actualSort (>) - -{-# INLINEABLE sortBy #-} -sortBy cmp = actualSort (\x y -> cmp x y == GT) - -{-# INLINE actualSort #-} -actualSort :: (a -> a -> Bool) -> [a] -> [a] -actualSort gt ns +sort = sortBy compare +sortBy cmp ns | [] <- ns = [] | [a] <- ns = [a] | [a,b] <- ns = merge [a] [b] @@ -1661,6 +1654,8 @@ actualSort gt ns | [a,b,c,d] <- ns = merge4 [a] [b] [c] [d] | otherwise = merge_all (sequences ns) where + x `gt` y = x `cmp` y == GT + sequences (a:b:xs) | a `gt` b = descending b [a] xs | otherwise = ascending b (a:) xs @@ -1668,7 +1663,7 @@ actualSort gt ns descending a as (b:bs) | a `gt` b = descending b (a:as) bs - descending a as bs = (a:as) : sequences bs + descending a as bs = (a:as): sequences bs ascending a as (b:bs) | not (a `gt` b) = ascending b (\ys -> as (a:ys)) bs @@ -1676,16 +1671,16 @@ actualSort gt ns in x : sequences bs merge_all [x] = x - merge_all xs = merge_all (reduce_once xs) - - reduce_once [] = [] - reduce_once [a] = [a] - reduce_once [a,b] = [merge a b] - reduce_once [a,b,c] = [merge3 a b c] - reduce_once [a,b,c,d,e] = [merge a b, merge3 c d e] - reduce_once [a,b,c,d,e,f] = [merge3 a b c, merge3 d e f] - reduce_once (a:b:c:d:xs) = let !x = merge4 a b c d - in x : reduce_once xs + merge_all xs = merge_all (reduce xs) + + reduce [] = [] + reduce [a] = [a] + reduce [a,b] = [merge a b] + reduce [a,b,c] = [merge3 a b c] + reduce [a,b,c,d,e] = [merge a b, merge3 c d e] + reduce [a,b,c,d,e,f] = [merge3 a b c, merge3 d e f] + reduce (a:b:c:d:xs) = let !x = merge4 a b c d + in x : reduce xs merge as@(a:as') bs@(b:bs') | a `gt` b = b : merge as bs' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2459bcd9e6ae00359491d9f71a15be45e566c890 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2459bcd9e6ae00359491d9f71a15be45e566c890 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 11:03:12 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 Apr 2024 07:03:12 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 3 commits: Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex Message-ID: <660a94701ea65_174ee1181369c974bb@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: ec24c9f7 by Rodrigo Mesquita at 2024-04-01T12:02:55+01:00 Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex CPP Support loadNativeObj in MachO - - - - - 9b7b7fca by Rodrigo Mesquita at 2024-04-01T12:02:55+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 62cb1b8e by Rodrigo Mesquita at 2024-04-01T12:02:55+01:00 Implement lookupSymbolInDLL for ExternalInterp - - - - - 12 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/rts.cabal Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = putMVar (interpLookupSymbolCache interp) emptyUFM -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInDLL) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -417,11 +421,8 @@ static int linker_init_done = 0 ; #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) static void *dl_prog_handle; -static regex_t re_invalid; -static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif +regex_t re_invalid; +regex_t re_realso; #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -578,8 +573,8 @@ static void * internal_dlsym(const char *symbol) { void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -587,7 +582,6 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } @@ -597,12 +591,10 @@ internal_dlsym(const char *symbol) { v = dlsym(nc->dlopen_handle, symbol); if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -645,14 +637,13 @@ internal_dlsym(const char *symbol) { void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { + ASSERT_LOCK_HELD(&linker_mutex); + #if defined(OBJFORMAT_MACHO) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif - - ACQUIRE_LOCK(&dl_mutex); // dlsym alters dlerror void *result = dlsym(handle, symbol_name); - RELEASE_LOCK(&dl_mutex); return result; } # endif @@ -1101,9 +1092,10 @@ void freeObjectCode (ObjectCode *oc) if (oc->type == DYNAMIC_OBJECT) { #if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); + // ROMES:TODO: This previously acquired dl_mutex. Check that acquiring linker_mutex here is fine. + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1868,73 +1860,20 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); + void *r = loadNativeObj_POSIX(path, errmsg); - if (r) { - RELEASE_LOCK(&linker_mutex); - return r; - } - - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - -#define NMATCH 5 - regmatch_t match[NMATCH]; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); - result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (*errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - RELEASE_LOCK(&linker_mutex); - // return original error if open fails - return NULL; - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)*errmsg); // Free old message before creating new one - r = loadNativeObj_ELF(line+match[2].rm_so, errmsg); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); } +#endif RELEASE_LOCK(&linker_mutex); return r; @@ -1982,7 +1921,7 @@ static HsInt unloadNativeObj_(void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ ===================================== rts/linker/Elf.c ===================================== @@ -27,11 +27,15 @@ #include "sm/OSMem.h" #include "linker/util.h" #include "linker/elf_util.h" +#include "linker/LoadNativeObjPosix.h" +#include #include #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,191 +2073,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - - /* If we load the same object multiple times, just return the - * already-loaded handle. Note that this is broken if unloadNativeObj - * is used, as we don’t do any reference counting; see #24345. - */ - ObjectCode *existing_oc = lookupObjectByPath(path); - if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { - if (existing_oc->type == DYNAMIC_OBJECT) { - retval = existing_oc->dlopen_handle; - goto success; - } - copyErrmsg(errmsg, "loadNativeObj_ELF: already loaded as non-dynamic object"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - // We want to use RTLD_NOW rather than RTLD_LAZY because in the case that - // DLINFO is available we want to learn eagerly about all symbols, however, - // there is no ldinfo on macos in which case we prefer using RTLD_LAZY. - // ROMES:TODO: ^ - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - nc->dlopen_handle = hdl; - nc->status = OBJECT_READY; - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - foreignExportsFinishedLoadingObject(); - - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2303,4 +2122,73 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +extern regex_t re_invalid; +extern regex_t re_realso; + +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex); + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + // ROMES:TODO: NO GOOD, this is almost recursive? no, as long we + // move the loadNativeObj_ELF to a shared impl + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,211 @@ +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "LinkerInternals.h" +#include "Rts.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + + ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09389a68224b1c01da226ebeb2359194d96c4293...62cb1b8e5ea5b790daa622e9b7b654dd4701d1ab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09389a68224b1c01da226ebeb2359194d96c4293...62cb1b8e5ea5b790daa622e9b7b654dd4701d1ab You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 12:00:20 2024 From: gitlab at gitlab.haskell.org (Jade (@Jade)) Date: Mon, 01 Apr 2024 08:00:20 -0400 Subject: [Git][ghc/ghc][wip/three-way-merge-sort] WIP Message-ID: <660aa1d492d1f_3a933914c79c8653@gitlab.mail> Jade pushed to branch wip/three-way-merge-sort at Glasgow Haskell Compiler / GHC Commits: 7607624a by Jade at 2024-04-01T14:04:48+02:00 WIP - - - - - 1 changed file: - libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs ===================================== @@ -1645,15 +1645,8 @@ Further improved using a four-way merge, with an additional performance increase https://gitlab.haskell.org/ghc/ghc/issues/24280 -} -{-# INLINEABLE sort #-} -sort = actualSort (>) - -{-# INLINEABLE sortBy #-} -sortBy cmp = actualSort (\x y -> cmp x y == GT) - -{-# INLINE actualSort #-} -actualSort :: (a -> a -> Bool) -> [a] -> [a] -actualSort gt ns +sort = sortBy compare +sortBy cmp ns | [] <- ns = [] | [a] <- ns = [a] | [a,b] <- ns = merge [a] [b] @@ -1661,6 +1654,8 @@ actualSort gt ns | [a,b,c,d] <- ns = merge4 [a] [b] [c] [d] | otherwise = merge_all (sequences ns) where + x `gt` y = x `cmp` y == GT + sequences (a:b:xs) | a `gt` b = descending b [a] xs | otherwise = ascending b (a:) xs @@ -1668,7 +1663,7 @@ actualSort gt ns descending a as (b:bs) | a `gt` b = descending b (a:as) bs - descending a as bs = (a:as) : sequences bs + descending a as bs = (a:as): sequences bs ascending a as (b:bs) | not (a `gt` b) = ascending b (\ys -> as (a:ys)) bs @@ -1676,16 +1671,16 @@ actualSort gt ns in x : sequences bs merge_all [x] = x - merge_all xs = merge_all (reduce_once xs) - - reduce_once [] = [] - reduce_once [a] = [a] - reduce_once [a,b] = [merge a b] - reduce_once [a,b,c] = [merge3 a b c] - reduce_once [a,b,c,d,e] = [merge a b, merge3 c d e] - reduce_once [a,b,c,d,e,f] = [merge3 a b c, merge3 d e f] - reduce_once (a:b:c:d:xs) = let !x = merge4 a b c d - in x : reduce_once xs + merge_all xs = merge_all (reduce xs) + + reduce [] = [] + reduce [a] = [a] + reduce [a,b] = [merge a b] + reduce [a,b,c] = [merge3 a b c] + reduce [a,b,c,d,e] = [merge a b, merge3 c d e] + reduce [a,b,c,d,e,f] = [merge3 a b c, merge3 d e f] + reduce (a:b:c:d:xs) = let !x = merge4 a b c d + in x : reduce xs merge as@(a:as') bs@(b:bs') | a `gt` b = b : merge as bs' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7607624a41b395b0003d279b5164c18b54d231ab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7607624a41b395b0003d279b5164c18b54d231ab You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 12:41:45 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 01 Apr 2024 08:41:45 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/mco-in-exprIsConApp Message-ID: <660aab89e34_3a933960eb5417515@gitlab.mail> Simon Peyton Jones pushed new branch wip/mco-in-exprIsConApp at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mco-in-exprIsConApp You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 12:43:43 2024 From: gitlab at gitlab.haskell.org (Jade (@Jade)) Date: Mon, 01 Apr 2024 08:43:43 -0400 Subject: [Git][ghc/ghc][wip/three-way-merge-sort] WIP Message-ID: <660aabff4428b_3a93396f5cc01934e@gitlab.mail> Jade pushed to branch wip/three-way-merge-sort at Glasgow Haskell Compiler / GHC Commits: 6da36b2e by Jade at 2024-04-01T14:48:11+02:00 WIP - - - - - 1 changed file: - libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs ===================================== @@ -1645,15 +1645,8 @@ Further improved using a four-way merge, with an additional performance increase https://gitlab.haskell.org/ghc/ghc/issues/24280 -} -{-# INLINEABLE sort #-} -sort = actualSort (>) - -{-# INLINEABLE sortBy #-} -sortBy cmp = actualSort (\x y -> cmp x y == GT) - -{-# INLINE actualSort #-} -actualSort :: (a -> a -> Bool) -> [a] -> [a] -actualSort gt ns +sort = sortBy compare +sortBy cmp ns | [] <- ns = [] | [a] <- ns = [a] | [a,b] <- ns = merge [a] [b] @@ -1661,6 +1654,8 @@ actualSort gt ns | [a,b,c,d] <- ns = merge4 [a] [b] [c] [d] | otherwise = merge_all (sequences ns) where + x `gt` y = x `cmp` y == GT + sequences (a:b:xs) | a `gt` b = descending b [a] xs | otherwise = ascending b (a:) xs @@ -1668,7 +1663,7 @@ actualSort gt ns descending a as (b:bs) | a `gt` b = descending b (a:as) bs - descending a as bs = (a:as) : sequences bs + descending a as bs = (a:as): sequences bs ascending a as (b:bs) | not (a `gt` b) = ascending b (\ys -> as (a:ys)) bs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6da36b2e1355abaec6fae1e1d6bbb470e0e43397 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6da36b2e1355abaec6fae1e1d6bbb470e0e43397 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 13:55:11 2024 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 01 Apr 2024 09:55:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/invis-pats-change-ast Message-ID: <660abcbf8947a_3a9339eddc0831380@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/invis-pats-change-ast at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/invis-pats-change-ast You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 14:41:54 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 01 Apr 2024 10:41:54 -0400 Subject: [Git][ghc/ghc][wip/mco-in-exprIsConApp] Wibble Message-ID: <660ac7b242ba7_3a933914a14f0348d1@gitlab.mail> Simon Peyton Jones pushed to branch wip/mco-in-exprIsConApp at Glasgow Haskell Compiler / GHC Commits: 70b12b2c by Simon Peyton Jones at 2024-04-01T15:41:40+01:00 Wibble - - - - - 2 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/SimpleOpt.hs Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3033,20 +3033,20 @@ pushCoDataCon :: DataCon -> [CoreExpr] -> MCoercion -- where co :: (T t1 .. tn) ~ to_ty -- The left-hand one must be a T, because exprIsConApp returned True -- but the right-hand one might not be. (Though it usually will.) -pushCoDataCon dc dc_args MRefl = Just (push_dc_refl dc dc_args) +pushCoDataCon dc dc_args MRefl = Just $! (push_dc_refl dc dc_args) pushCoDataCon dc dc_args (MCo co) = push_dc_gen dc dc_args co (coercionKind co) push_dc_refl :: DataCon -> [CoreExpr] -> (DataCon, [Type], [CoreExpr]) push_dc_refl dc dc_args = (dc, map exprToType univ_ty_args, rest_args) where - (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args + !(univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args push_dc_gen :: DataCon -> [CoreExpr] -> Coercion -> Pair Type -> Maybe (DataCon, [Type], [CoreExpr]) push_dc_gen dc dc_args co (Pair from_ty to_ty) | from_ty `eqType` to_ty -- try cheap test first - = Just (push_dc_refl dc dc_args) + = Just $! (push_dc_refl dc dc_args) | Just (to_tc, to_tc_arg_tys) <- splitTyConApp_maybe to_ty , to_tc == dataConTyCon dc ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -1251,7 +1251,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- See Note [Push coercions in exprIsConApp_maybe] = go subst floats expr (CC args' (m_co1' `mkTransMCo` m_co2)) - go subst floats (App fun arg) (CC args co) + go subst floats (App fun arg) (CC args mco) | let arg_type = exprType arg , not (isTypeArg arg) && needsCaseBinding arg_type arg -- An unlifted argument that’s not ok for speculation must not simply be @@ -1274,17 +1274,17 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr bndr = uniqAway (subst_in_scope subst) (mkWildValBinder ManyTy arg_type) float = FloatCase arg' bndr DEFAULT [] subst' = subst_extend_in_scope subst bndr - in go subst' (float:floats) fun (CC (Var bndr : args) co) + in go subst' (float:floats) fun (CC (Var bndr : args) mco) | otherwise - = go subst floats fun (CC (subst_expr subst arg : args) co) + = go subst floats fun (CC (subst_expr subst arg : args) mco) - go subst floats (Lam bndr body) (CC (arg:args) co) + go subst floats (Lam bndr body) (CC (arg:args) mco) | do_beta_by_substitution bndr arg - = go (extend subst bndr arg) floats body (CC args co) + = go (extend subst bndr arg) floats body (CC args mco) | otherwise = let (subst', bndr') = subst_bndr subst bndr float = FloatLet (NonRec bndr' arg) - in go subst' (float:floats) body (CC args co) + in go subst' (float:floats) body (CC args mco) go subst floats (Let (NonRec bndr rhs) expr) cont | not (isJoinId bndr) @@ -1309,12 +1309,12 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr (lookupIdSubst sub v) cont - go (Left in_scope) floats (Var fun) cont@(CC args co) + go (Left in_scope) floats (Var fun) cont@(CC args mco) | Just con <- isDataConWorkId_maybe fun , count isValArg args == idArity fun = succeedWith in_scope floats $ - pushCoDataCon con args co + pushCoDataCon con args mco -- Look through data constructor wrappers: they inline late (See Note -- [Activation for data constructor wrappers]) but we want to do @@ -1334,7 +1334,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- simplOptExpr initialises the in-scope set with exprFreeVars, -- but that doesn't account for DFun unfoldings = succeedWith in_scope floats $ - pushCoDataCon con (map (substExpr subst) dfun_args) co + pushCoDataCon con (map (substExpr subst) dfun_args) mco -- Look through unfoldings, but only arity-zero one; -- if arity > 0 we are effectively inlining a function call, @@ -1352,7 +1352,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr , [arg] <- args , Just (LitString str) <- exprIsLiteral_maybe ise arg = succeedWith in_scope floats $ - dealWithStringLiteral fun str co + dealWithStringLiteral fun str mco where unfolding = id_unf fun extend_in_scope unf_fvs @@ -1408,9 +1408,9 @@ dealWithStringLiteral :: Var -> BS.ByteString -> MCoercion -- This is not possible with user-supplied empty literals, GHC.Core.Make.mkStringExprFS -- turns those into [] automatically, but just in case something else in GHC -- generates a string literal directly. -dealWithStringLiteral fun str co = +dealWithStringLiteral fun str mco = case utf8UnconsByteString str of - Nothing -> pushCoDataCon nilDataCon [Type charTy] co + Nothing -> pushCoDataCon nilDataCon [Type charTy] mco Just (char, charTail) -> let char_expr = mkConApp charDataCon [mkCharLit char] -- In singleton strings, just add [] instead of unpackCstring# ""#. @@ -1419,7 +1419,7 @@ dealWithStringLiteral fun str co = else App (Var fun) (Lit (LitString charTail)) - in pushCoDataCon consDataCon [Type charTy, char_expr, rest] co + in pushCoDataCon consDataCon [Type charTy, char_expr, rest] mco {- Note [Unfolding DFuns] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70b12b2c7b2ec36c87ed4e19afcbaae687d703fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70b12b2c7b2ec36c87ed4e19afcbaae687d703fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 15:52:40 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 Apr 2024 11:52:40 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 5 commits: linker: Avoid linear search when looking up Haskell symbols via dlsym Message-ID: <660ad8488f57b_3a93391c5893c50074@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 1a8f3b4b by Alexis King at 2024-04-01T12:19:39+01:00 linker: Avoid linear search when looking up Haskell symbols via dlsym See the primary Note [Looking up symbols in the relevant objects] for a more in-depth explanation. When dynamically loading a Haskell symbol (typical when running a splice or GHCi expression), before this commit we would search for the symbol in all dynamic libraries that were loaded. However, this could be very inefficient when too many packages are loaded (which can happen if there are many package dependencies) because the time to lookup the would be linear in the number of packages loaded. This commit drastically improves symbol loading performance by introducing a mapping from units to the handles of corresponding loaded dlls. These handles are returned by dlopen when we load a dll, and can then be used to look up in a specific dynamic library. Looking up a given Name is now much more precise because we can get lookup its unit in the mapping and lookup the symbol solely in the handles of the dynamic libraries loaded for that unit. In one measurement, the wait time before the expression was executed went from 35 seconds down to 2s. This commit also includes Note [Symbols may not be found in pkgs_loaded], explaining the fallback to the old behaviour in case no dll can be found in the unit mapping for a given Name. Fixes #23415 Co-authored-by: Rodrigo Mesquita (@alt-romes) - - - - - 1bbfd7d7 by Rodrigo Mesquita at 2024-04-01T16:51:56+01:00 wip: make addDLL wrapper around loadNativeObj wip: use loadNativeObj to implement addDLL Refactor loadNativeObj_ELF to _POSIX and delete dl_mutex CPP Support loadNativeObj in MachO - - - - - 65397d7f by Rodrigo Mesquita at 2024-04-01T16:51:57+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 3bba675c by Rodrigo Mesquita at 2024-04-01T16:51:58+01:00 Implement lookupSymbolInDLL for ExternalInterp - - - - - 2d86193a by Rodrigo Mesquita at 2024-04-01T16:51:58+01:00 hwere to - - - - - 23 changed files: - compiler/GHC.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/MacOS.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/ObjLink.hs - libraries/ghci/GHCi/Run.hs - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/include/rts/Linker.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/rts.cabal - testsuite/tests/ghci/linking/dyn/T3372.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -24,6 +24,7 @@ import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHC.Builtin.PrimOps +import GHC.Builtin.PrimOps.Ids import GHC.Builtin.Names import GHC.Unit.Types @@ -38,6 +39,8 @@ import GHC.Utils.Outputable import GHC.Types.Name import GHC.Types.Name.Env +import qualified GHC.Types.Id as Id +import GHC.Types.Unique.DFM import Language.Haskell.Syntax.Module.Name @@ -52,31 +55,32 @@ import GHC.Exts linkBCO :: Interp + -> PkgsLoaded -> LinkerEnv -> NameEnv Int -> UnlinkedBCO -> IO ResolvedBCO -linkBCO interp le bco_ix +linkBCO interp pkgs_loaded le bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - lits <- mapM (fmap fromIntegral . lookupLiteral interp le) (ssElts lits0) - ptrs <- mapM (resolvePtr interp le bco_ix) (ssElts ptrs0) + lits <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (ssElts lits0) + ptrs <- mapM (resolvePtr interp pkgs_loaded le bco_ix) (ssElts ptrs0) return (ResolvedBCO isLittleEndian arity insns bitmap (listArray (0, fromIntegral (sizeSS lits0)-1) lits) (addListToSS emptySS ptrs)) -lookupLiteral :: Interp -> LinkerEnv -> BCONPtr -> IO Word -lookupLiteral interp le ptr = case ptr of +lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word +lookupLiteral interp pkgs_loaded le ptr = case ptr of BCONPtrWord lit -> return lit BCONPtrLbl sym -> do Ptr a# <- lookupStaticPtr interp sym return (W# (int2Word# (addr2Int# a#))) BCONPtrItbl nm -> do - Ptr a# <- lookupIE interp (itbl_env le) nm + Ptr a# <- lookupIE interp pkgs_loaded (itbl_env le) nm return (W# (int2Word# (addr2Int# a#))) BCONPtrAddr nm -> do - Ptr a# <- lookupAddr interp (addr_env le) nm + Ptr a# <- lookupAddr interp pkgs_loaded (addr_env le) nm return (W# (int2Word# (addr2Int# a#))) BCONPtrStr _ -> -- should be eliminated during assembleBCOs @@ -90,19 +94,19 @@ lookupStaticPtr interp addr_of_label_string = do Nothing -> linkFail "GHC.ByteCode.Linker: can't find label" (unpackFS addr_of_label_string) -lookupIE :: Interp -> ItblEnv -> Name -> IO (Ptr ()) -lookupIE interp ie con_nm = +lookupIE :: Interp -> PkgsLoaded -> ItblEnv -> Name -> IO (Ptr ()) +lookupIE interp pkgs_loaded ie con_nm = case lookupNameEnv ie con_nm of Just (_, ItblPtr a) -> return (fromRemotePtr (castRemotePtr a)) Nothing -> do -- try looking up in the object files. let sym_to_find1 = nameToCLabel con_nm "con_info" - m <- lookupSymbol interp sym_to_find1 + m <- lookupHsSymbol interp pkgs_loaded con_nm "con_info" case m of Just addr -> return addr Nothing -> do -- perhaps a nullary constructor? let sym_to_find2 = nameToCLabel con_nm "static_info" - n <- lookupSymbol interp sym_to_find2 + n <- lookupHsSymbol interp pkgs_loaded con_nm "static_info" case n of Just addr -> return addr Nothing -> linkFail "GHC.ByteCode.Linker.lookupIE" @@ -110,34 +114,35 @@ lookupIE interp ie con_nm = unpackFS sym_to_find2) -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode -lookupAddr :: Interp -> AddrEnv -> Name -> IO (Ptr ()) -lookupAddr interp ae addr_nm = do +lookupAddr :: Interp -> PkgsLoaded -> AddrEnv -> Name -> IO (Ptr ()) +lookupAddr interp pkgs_loaded ae addr_nm = do case lookupNameEnv ae addr_nm of Just (_, AddrPtr ptr) -> return (fromRemotePtr ptr) Nothing -> do -- try looking up in the object files. let sym_to_find = nameToCLabel addr_nm "bytes" -- see Note [Bytes label] in GHC.Cmm.CLabel - m <- lookupSymbol interp sym_to_find + m <- lookupHsSymbol interp pkgs_loaded addr_nm "bytes" case m of Just ptr -> return ptr Nothing -> linkFail "GHC.ByteCode.Linker.lookupAddr" (unpackFS sym_to_find) -lookupPrimOp :: Interp -> PrimOp -> IO (RemotePtr ()) -lookupPrimOp interp primop = do +lookupPrimOp :: Interp -> PkgsLoaded -> PrimOp -> IO (RemotePtr ()) +lookupPrimOp interp pkgs_loaded primop = do let sym_to_find = primopToCLabel primop "closure" - m <- lookupSymbol interp (mkFastString sym_to_find) + m <- lookupHsSymbol interp pkgs_loaded (Id.idName $ primOpId primop) "closure" case m of Just p -> return (toRemotePtr p) Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE(primop)" sym_to_find resolvePtr :: Interp + -> PkgsLoaded -> LinkerEnv -> NameEnv Int -> BCOPtr -> IO ResolvedBCOPtr -resolvePtr interp le bco_ix ptr = case ptr of +resolvePtr interp pkgs_loaded le bco_ix ptr = case ptr of BCOPtrName nm | Just ix <- lookupNameEnv bco_ix nm -> return (ResolvedBCORef ix) -- ref to another BCO in this group @@ -149,20 +154,38 @@ resolvePtr interp le bco_ix ptr = case ptr of -> assertPpr (isExternalName nm) (ppr nm) $ do let sym_to_find = nameToCLabel nm "closure" - m <- lookupSymbol interp sym_to_find + m <- lookupHsSymbol interp pkgs_loaded nm "closure" case m of Just p -> return (ResolvedBCOStaticPtr (toRemotePtr p)) Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE" (unpackFS sym_to_find) BCOPtrPrimOp op - -> ResolvedBCOStaticPtr <$> lookupPrimOp interp op + -> ResolvedBCOStaticPtr <$> lookupPrimOp interp pkgs_loaded op BCOPtrBCO bco - -> ResolvedBCOPtrBCO <$> linkBCO interp le bco_ix bco + -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le bco_ix bco BCOPtrBreakArray breakarray -> withForeignRef breakarray $ \ba -> return (ResolvedBCOPtrBreakArray ba) +lookupHsSymbol :: Interp -> PkgsLoaded -> Name -> String -> IO (Maybe (Ptr ())) +lookupHsSymbol interp pkgs_loaded nm sym_suffix = do + massertPpr (isExternalName nm) (ppr nm) + let sym_to_find = nameToCLabel nm sym_suffix + pkg_id = moduleUnitId $ nameModule nm + loaded_dlls = maybe [] loaded_pkg_hs_dlls $ lookupUDFM pkgs_loaded pkg_id + + go (dll:dlls) = do + mb_ptr <- lookupSymbolInDLL interp dll sym_to_find + case mb_ptr of + Just ptr -> pure (Just ptr) + Nothing -> go dlls + go [] = + -- See Note [Symbols may not be found in pkgs_loaded] in GHC.Linker.Types + lookupSymbol interp sym_to_find + + go loaded_dlls + linkFail :: String -> String -> IO a linkFail who what = throwGhcExceptionIO (ProgramError $ ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -420,12 +420,12 @@ loadExternalPluginLib :: FilePath -> IO () loadExternalPluginLib path = do -- load library loadDLL path >>= \case - Just errmsg -> pprPanic "loadExternalPluginLib" - (vcat [ text "Can't load plugin library" - , text " Library path: " <> text path - , text " Error : " <> text errmsg - ]) - Nothing -> do + Left errmsg -> pprPanic "loadExternalPluginLib" + (vcat [ text "Can't load plugin library" + , text " Library path: " <> text path + , text " Error : " <> text errmsg + ]) + Right _ -> do -- TODO: use returned LoadedDLL? -- resolve objects resolveObjs >>= \case True -> return () ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Tc.Utils.Monad import GHC.Runtime.Interpreter import GHCi.RemoteTypes import GHC.Iface.Load +import GHCi.Message (LoadedDLL) import GHC.ByteCode.Linker import GHC.ByteCode.Asm @@ -172,7 +173,7 @@ emptyLoaderState = LoaderState -- -- The linker's symbol table is populated with RTS symbols using an -- explicit list. See rts/Linker.c for details. - where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqDSet) + where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] [] emptyUniqDSet) extendLoadedEnv :: Interp -> [(Name,ForeignHValue)] -> IO () extendLoadedEnv interp new_bindings = @@ -221,8 +222,8 @@ loadDependencies -> SrcSpan -> [Module] -> IO (LoaderState, SuccessFlag, [Linkable], PkgsLoaded) -- ^ returns the set of linkables required +-- When called, the loader state must have been initialized (see `initLoaderState`) loadDependencies interp hsc_env pls span needed_mods = do --- initLoaderState (hsc_dflags hsc_env) dl let opts = initLinkDepsOpts hsc_env -- Find what packages and linkables are required @@ -512,25 +513,25 @@ preloadLib interp hsc_env lib_paths framework_paths pls lib_spec = do DLL dll_unadorned -> do maybe_errstr <- loadDLL interp (platformSOName platform dll_unadorned) case maybe_errstr of - Nothing -> maybePutStrLn logger "done" - Just mm | platformOS platform /= OSDarwin -> + Right _ -> maybePutStrLn logger "done" + Left mm | platformOS platform /= OSDarwin -> preloadFailed mm lib_paths lib_spec - Just mm | otherwise -> do + Left mm | otherwise -> do -- As a backup, on Darwin, try to also load a .so file -- since (apparently) some things install that way - see -- ticket #8770. let libfile = ("lib" ++ dll_unadorned) <.> "so" err2 <- loadDLL interp libfile case err2 of - Nothing -> maybePutStrLn logger "done" - Just _ -> preloadFailed mm lib_paths lib_spec + Right _ -> maybePutStrLn logger "done" + Left _ -> preloadFailed mm lib_paths lib_spec return pls DLLPath dll_path -> do do maybe_errstr <- loadDLL interp dll_path case maybe_errstr of - Nothing -> maybePutStrLn logger "done" - Just mm -> preloadFailed mm lib_paths lib_spec + Right _ -> maybePutStrLn logger "done" + Left mm -> preloadFailed mm lib_paths lib_spec return pls Framework framework -> @@ -614,7 +615,7 @@ loadExpr interp hsc_env span root_ul_bco = do -- Load the necessary packages and linkables let le = linker_env pls bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)] - resolved <- linkBCO interp le bco_ix root_ul_bco + resolved <- linkBCO interp (pkgs_loaded pls) le bco_ix root_ul_bco [root_hvref] <- createBCOs interp [resolved] fhv <- mkFinalizedHValue interp root_hvref return (pls, fhv) @@ -678,7 +679,7 @@ loadDecls interp hsc_env span cbc at CompiledByteCode{..} = do , addr_env = plusNameEnv (addr_env le) bc_strs } -- Link the necessary packages and linkables - new_bindings <- linkSomeBCOs interp le2 [cbc] + new_bindings <- linkSomeBCOs interp (pkgs_loaded pls) le2 [cbc] nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings let ce2 = extendClosureEnv (closure_env le2) nms_fhvs !pls2 = pls { linker_env = le2 { closure_env = ce2 } } @@ -860,8 +861,8 @@ dynLoadObjs interp hsc_env pls at LoaderState{..} objs = do changeTempFilesLifetime tmpfs TFL_GhcSession [soFile] m <- loadDLL interp soFile case m of - Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } - Just err -> linkFail msg err + Right _ -> return $! pls { temp_sos = (libPath, libName) : temp_sos } + Left err -> linkFail msg err where msg = "GHC.Linker.Loader.dynLoadObjs: Loading temp shared object failed" @@ -901,7 +902,7 @@ dynLinkBCOs interp pls bcos = do ae2 = foldr plusNameEnv (addr_env le1) (map bc_strs cbcs) le2 = le1 { itbl_env = ie2, addr_env = ae2 } - names_and_refs <- linkSomeBCOs interp le2 cbcs + names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs -- We only want to add the external ones to the ClosureEnv let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs @@ -916,6 +917,7 @@ dynLinkBCOs interp pls bcos = do -- Link a bunch of BCOs and return references to their values linkSomeBCOs :: Interp + -> PkgsLoaded -> LinkerEnv -> [CompiledByteCode] -> IO [(Name,HValueRef)] @@ -923,7 +925,7 @@ linkSomeBCOs :: Interp -- the incoming unlinked BCOs. Each gives the -- value of the corresponding unlinked BCO -linkSomeBCOs interp le mods = foldr fun do_link mods [] +linkSomeBCOs interp pkgs_loaded le mods = foldr fun do_link mods [] where fun CompiledByteCode{..} inner accum = inner (bc_bcos : accum) @@ -932,7 +934,7 @@ linkSomeBCOs interp le mods = foldr fun do_link mods [] let flat = [ bco | bcos <- mods, bco <- bcos ] names = map unlinkedBCOName flat bco_ix = mkNameEnv (zip names [0..]) - resolved <- sequence [ linkBCO interp le bco_ix bco | bco <- flat ] + resolved <- sequence [ linkBCO interp pkgs_loaded le bco_ix bco | bco <- flat ] hvrefs <- createBCOs interp resolved return (zip names hvrefs) @@ -1094,18 +1096,18 @@ loadPackages' interp hsc_env new_pks pls = do -- Link dependents first ; pkgs' <- link pkgs deps -- Now link the package itself - ; (hs_cls, extra_cls) <- loadPackage interp hsc_env pkg_cfg + ; (hs_cls, extra_cls, loaded_dlls) <- loadPackage interp hsc_env pkg_cfg ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg | dep_pkg <- deps , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) ] - ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls trans_deps)) } + ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls loaded_dlls trans_deps)) } | otherwise = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (unitIdFS new_pkg))) -loadPackage :: Interp -> HscEnv -> UnitInfo -> IO ([LibrarySpec], [LibrarySpec]) +loadPackage :: Interp -> HscEnv -> UnitInfo -> IO ([LibrarySpec], [LibrarySpec], [RemotePtr LoadedDLL]) loadPackage interp hsc_env pkg = do let dflags = hsc_dflags hsc_env @@ -1147,7 +1149,9 @@ loadPackage interp hsc_env pkg let classifieds = hs_classifieds ++ extra_classifieds -- Complication: all the .so's must be loaded before any of the .o's. - let known_dlls = [ dll | DLLPath dll <- classifieds ] + let known_hs_dlls = [ dll | DLLPath dll <- hs_classifieds ] + known_extra_dlls = [ dll | DLLPath dll <- extra_classifieds ] + known_dlls = known_hs_dlls ++ known_extra_dlls #if defined(CAN_LOAD_DLL) dlls = [ dll | DLL dll <- classifieds ] #endif @@ -1168,10 +1172,13 @@ loadPackage interp hsc_env pkg loadFrameworks interp platform pkg -- See Note [Crash early load_dyn and locateLib] -- Crash early if can't load any of `known_dlls` - mapM_ (load_dyn interp hsc_env True) known_dlls + mapM_ (load_dyn interp hsc_env True) known_extra_dlls + loaded_dlls <- mapMaybeM (load_dyn interp hsc_env True) known_hs_dlls -- For remaining `dlls` crash early only when there is surely -- no package's DLL around ... (not is_dyn) mapM_ (load_dyn interp hsc_env (not is_dyn) . platformSOName platform) dlls +#else + let loaded_dlls = [] #endif -- After loading all the DLLs, we can load the static objects. -- Ordering isn't important here, because we do one final link @@ -1191,7 +1198,7 @@ loadPackage interp hsc_env pkg if succeeded ok then do maybePutStrLn logger "done." - return (hs_classifieds, extra_classifieds) + return (hs_classifieds, extra_classifieds, loaded_dlls) else let errmsg = text "unable to load unit `" <> pprUnitInfoForUser pkg <> text "'" in throwGhcExceptionIO (InstallationError (showSDoc dflags errmsg)) @@ -1244,19 +1251,20 @@ restriction very easily. -- can be passed directly to loadDLL. They are either fully-qualified -- ("/usr/lib/libfoo.so"), or unqualified ("libfoo.so"). In the latter case, -- loadDLL is going to search the system paths to find the library. -load_dyn :: Interp -> HscEnv -> Bool -> FilePath -> IO () +load_dyn :: Interp -> HscEnv -> Bool -> FilePath -> IO (Maybe (RemotePtr LoadedDLL)) load_dyn interp hsc_env crash_early dll = do r <- loadDLL interp dll case r of - Nothing -> return () - Just err -> + Right loaded_dll -> pure (Just loaded_dll) + Left err -> if crash_early then cmdLineErrorIO err - else + else do when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts) $ logMsg logger (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing) noSrcSpan $ withPprStyle defaultUserStyle (note err) + pure Nothing where diag_opts = initDiagOpts (hsc_dflags hsc_env) logger = hsc_logger hsc_env ===================================== compiler/GHC/Linker/MacOS.hs ===================================== @@ -172,6 +172,6 @@ loadFramework interp extraPaths rootname findLoadDLL (p:ps) errs = do { dll <- loadDLL interp (p fwk_file) ; case dll of - Nothing -> return Nothing - Just err -> findLoadDLL ps ((p ++ ": " ++ err):errs) + Right _ -> return Nothing + Left err -> findLoadDLL ps ((p ++ ": " ++ err):errs) } ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -40,7 +40,8 @@ import GHC.Prelude import GHC.Unit ( UnitId, Module ) import GHC.ByteCode.Types ( ItblEnv, AddrEnv, CompiledByteCode ) import GHC.Fingerprint.Type ( Fingerprint ) -import GHCi.RemoteTypes ( ForeignHValue ) +import GHCi.RemoteTypes ( ForeignHValue, RemotePtr ) +import GHCi.Message ( LoadedDLL ) import GHC.Types.Var ( Id ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnvList, filterNameEnv ) @@ -75,6 +76,57 @@ initialised. The LinkerEnv maps Names to actual closures (for interpreted code only), for use during linking. + +Note [Looking up symbols in the relevant objects] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In #23415, we determined that a lot of time (>10s, or even up to >35s!) was +being spent on dynamically loading symbols before actually interpreting code +when `:main` was run in GHCi. The root cause was that for each symbol we wanted +to lookup, we would traverse the list of loaded objects and try find the symbol +in each of them with dlsym (i.e. looking up a symbol was, worst case, linear in +the amount of loaded objects). + +To drastically improve load time (XXX(TODO:get better measure against 10s +baseline rather than 35second one) to <3s), we now: + +1. For every of the native objects loaded for a given unit, store the handles returned by `dlopen`. + - In `pkgs_loaded` of the `LoaderState`, which maps `UnitId`s to + `LoadedPkgInfo`s, where the handles live in its field `loaded_pkg_hs_dlls`. + +2. When looking up a Name (e.g. `lookupHsSymbol`), find that name's `UnitId` in + the `pkgs_loaded` mapping, + +3. And only look for the symbol (with `dlsym`) on the /handles relevant to that + unit/, rather than in every loaded object. + +Note [Symbols may not be found in pkgs_loaded] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Despite storing and looking for symbols in the relevant loaded libraries +handles for a given unit-id, as described in the note above, we may still have +to fallback to the "slow" `lookupSymbol` function (see its "fallback" call in +`lookupHsSymbol`). + +TODO: Ben: my understanding here is flawed; could you make this clearer?. + +This fallback is still needed because a given unit may be associated with +static objects (`loaded_pkg_hs_objs`) only and no dynamic libraries, but we +only `lookupSymbolInDLL` for loaded dynamic libraries. In that case, +`lookupSymbol` will do the right thing because, besides looking up the symbol +in every loaded dylib, it will end up searching the static name table and find those symbols. + +Arguably, we should rather generalise `lookupSymbolInDLL` to +`lookupSymbolInObject`, where an object may be a DLL/native object (as in +`loadNativeObj`), or e.g. a static archive, instead of having a special case +for dynamic libraries. + +This fallback is further needed because we don't look in the haskell objects +loaded for the home units (see the call to `loadModuleLinkables` in +`loadDependencies`, as opposed to the call to `loadPackages'` in the same +function which updates `pkgs_loaded`). We should ultimately keep track of the +objects loaded (probably in `objs_loaded`, for which `LinkableSet` is a bit +unsatisfactory, see a suggestion in 51c5c4eb1f2a33e4dc88e6a37b7b7c135234ce9b) +and be able to lookup symbols specifically in them too (similarly to +`lookupSymbolInDLL`). -} newtype Loader = Loader { loader_state :: MVar (Maybe LoaderState) } @@ -146,11 +198,13 @@ data LoadedPkgInfo { loaded_pkg_uid :: !UnitId , loaded_pkg_hs_objs :: ![LibrarySpec] , loaded_pkg_non_hs_objs :: ![LibrarySpec] + , loaded_pkg_hs_dlls :: ![RemotePtr LoadedDLL] + -- ^ See Note [Looking up symbols in the relevant objects] , loaded_pkg_trans_deps :: UniqDSet UnitId } instance Outputable LoadedPkgInfo where - ppr (LoadedPkgInfo uid hs_objs non_hs_objs trans_deps) = + ppr (LoadedPkgInfo uid hs_objs non_hs_objs _ trans_deps) = vcat [ppr uid , ppr hs_objs , ppr non_hs_objs @@ -159,10 +213,10 @@ instance Outputable LoadedPkgInfo where -- | Information we can use to dynamically link modules into the compiler data Linkable = LM { - linkableTime :: !UTCTime, -- ^ Time at which this linkable was built + linkableTime :: !UTCTime, -- ^ Time at which this linkable was built -- (i.e. when the bytecodes were produced, -- or the mod date on the files) - linkableModule :: !Module, -- ^ The linkable module itself + linkableModule :: !Module, -- ^ The linkable module itself linkableUnlinked :: [Unlinked] -- ^ Those files and chunks of code we have yet to link. -- ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -35,6 +35,7 @@ module GHC.Runtime.Interpreter -- * The object-code linker , initObjLinker , lookupSymbol + , lookupSymbolInDLL , lookupClosure , loadDLL , loadArchive @@ -151,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -440,57 +441,78 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + +lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of +#if defined(HAVE_INTERNAL_INTERPRETER) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) +#endif + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either -- an absolute pathname to the file, or a relative filename -- (e.g. "libfoo.so" or "foo.dll"). In the latter case, loadDLL -- searches the standard locations for the appropriate library. --- --- Returns: --- --- Nothing => success --- Just err_msg => failure -loadDLL :: Interp -> String -> IO (Maybe String) +loadDLL :: Interp -> String -> IO (Either String (RemotePtr LoadedDLL)) loadDLL interp str = interpCmd interp (LoadDLL str) loadArchive :: Interp -> String -> IO () @@ -549,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -23,6 +23,7 @@ module GHCi.Message , getMessage, putMessage, getTHMessage, putTHMessage , Pipe(..), remoteCall, remoteTHCall, readPipe, writePipe , BreakModule + , LoadedDLL ) where import Prelude -- See note [Why do we import Prelude here?] @@ -73,8 +74,9 @@ data Message a where -- These all invoke the corresponding functions in the RTS Linker API. InitLinker :: Message () LookupSymbol :: String -> Message (Maybe (RemotePtr ())) + LookupSymbolInDLL :: RemotePtr LoadedDLL -> String -> Message (Maybe (RemotePtr ())) LookupClosure :: String -> Message (Maybe HValueRef) - LoadDLL :: String -> Message (Maybe String) + LoadDLL :: String -> Message (Either String (RemotePtr LoadedDLL)) LoadArchive :: String -> Message () -- error? LoadObj :: String -> Message () -- error? UnloadObj :: String -> Message () -- error? @@ -415,6 +417,9 @@ instance Binary a => Binary (EvalResult a) -- that type isn't available here. data BreakModule +-- | A dummy type that tags pointers returned by 'LoadDLL'. +data LoadedDLL + -- SomeException can't be serialized because it contains dynamic -- types. However, we do very limited things with the exceptions that -- are thrown by interpreted computations: @@ -544,6 +549,7 @@ getMessage = do 37 -> Msg <$> return RtsRevertCAFs 38 -> Msg <$> (ResumeSeq <$> get) 39 -> Msg <$> (NewBreakModule <$> get) + 40 -> Msg <$> (LookupSymbolInDLL <$> get <*> get) _ -> error $ "Unknown Message code " ++ (show b) putMessage :: Message a -> Put @@ -588,7 +594,8 @@ putMessage m = case m of Seq a -> putWord8 36 >> put a RtsRevertCAFs -> putWord8 37 ResumeSeq a -> putWord8 38 >> put a - NewBreakModule name -> putWord8 39 >> put name + NewBreakModule name -> putWord8 39 >> put name + LookupSymbolInDLL dll str -> putWord8 40 >> put dll >> put str {- Note [Parallelize CreateBCOs serialization] ===================================== libraries/ghci/GHCi/ObjLink.hs ===================================== @@ -18,6 +18,7 @@ module GHCi.ObjLink , unloadObj , purgeObj , lookupSymbol + , lookupSymbolInDLL , lookupClosure , resolveObjs , addLibrarySearchPath @@ -27,18 +28,17 @@ module GHCi.ObjLink import Prelude -- See note [Why do we import Prelude here?] import GHCi.RemoteTypes +import GHCi.Message (LoadedDLL) import Control.Exception (throwIO, ErrorCall(..)) import Control.Monad ( when ) import Foreign.C -import Foreign.Marshal.Alloc ( free ) -import Foreign ( nullPtr ) +import Foreign.Marshal.Alloc ( alloca, free ) +import Foreign ( nullPtr, peek ) import GHC.Exts import System.Posix.Internals ( CFilePath, withFilePath, peekFilePath ) import System.FilePath ( dropExtension, normalise ) - - -- --------------------------------------------------------------------------- -- RTS Linker Interface -- --------------------------------------------------------------------------- @@ -70,6 +70,15 @@ lookupSymbol str_in = do then return Nothing else return (Just addr) +lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a)) +lookupSymbolInDLL dll str_in = do + let str = prefixUnderscore str_in + withCAString str $ \c_str -> do + addr <- c_lookupSymbolInNativeObj dll c_str + if addr == nullPtr + then return Nothing + else return (Just addr) + lookupClosure :: String -> IO (Maybe HValueRef) lookupClosure str = do m <- lookupSymbol str @@ -89,7 +98,7 @@ prefixUnderscore -- (e.g. "libfoo.so" or "foo.dll"). In the latter case, loadDLL -- searches the standard locations for the appropriate library. -- -loadDLL :: String -> IO (Maybe String) +loadDLL :: String -> IO (Either String (Ptr LoadedDLL)) -- Nothing => success -- Just err_msg => failure loadDLL str0 = do @@ -101,12 +110,16 @@ loadDLL str0 = do str | isWindowsHost = dropExtension str0 | otherwise = str0 -- - maybe_errmsg <- withFilePath (normalise str) $ \dll -> c_addDLL dll - if maybe_errmsg == nullPtr - then return Nothing - else do str <- peekCString maybe_errmsg - free maybe_errmsg - return (Just str) + (maybe_handle, maybe_errmsg) <- withFilePath (normalise str) $ \dll -> + alloca $ \errmsg_ptr -> (,) + <$> c_loadNativeObj dll errmsg_ptr + <*> peek errmsg_ptr + + if maybe_handle == nullPtr + then do str <- peekCString maybe_errmsg + free maybe_errmsg + return (Left str) + else return (Right maybe_handle) loadArchive :: String -> IO () loadArchive str = do @@ -163,7 +176,8 @@ resolveObjs = do -- Foreign declarations to RTS entry points which does the real work; -- --------------------------------------------------------------------------- -foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> IO CString +foreign import ccall unsafe "loadNativeObj" c_loadNativeObj :: CFilePath -> Ptr CString -> IO (Ptr LoadedDLL) +foreign import ccall unsafe "lookupSymbolInNativeObj" c_lookupSymbolInNativeObj :: Ptr LoadedDLL -> CString -> IO (Ptr a) foreign import ccall unsafe "initLinker_" c_initLinker_ :: CInt -> IO () foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -66,7 +66,7 @@ run m = case m of LookupClosure str -> lookupJSClosure str #else InitLinker -> initObjLinker RetainCAFs - LoadDLL str -> loadDLL str + LoadDLL str -> fmap toRemotePtr <$> loadDLL str LoadArchive str -> loadArchive str LoadObj str -> loadObj str UnloadObj str -> unloadObj str @@ -81,6 +81,8 @@ run m = case m of #endif RtsRevertCAFs -> rts_revertCAFs LookupSymbol str -> fmap toRemotePtr <$> lookupSymbol str + LookupSymbolInDLL dll str -> + fmap toRemotePtr <$> lookupSymbolInDLL (fromRemotePtr dll) str FreeHValueRefs rs -> mapM_ freeRemoteRef rs AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr EvalStmt opts r -> evalStmt opts r ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInDLL) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -417,11 +421,8 @@ static int linker_init_done = 0 ; #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) static void *dl_prog_handle; -static regex_t re_invalid; -static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif +regex_t re_invalid; +regex_t re_realso; #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -556,90 +551,6 @@ exitLinker( void ) { # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -/* Suppose in ghci we load a temporary SO for a module containing - f = 1 - and then modify the module, recompile, and load another temporary - SO with - f = 2 - Then as we don't unload the first SO, dlsym will find the - f = 1 - symbol whereas we want the - f = 2 - symbol. We therefore need to keep our own SO handle list, and - try SOs in the right order. */ - -typedef - struct _OpenedSO { - struct _OpenedSO* next; - void *handle; - } - OpenedSO; - -/* A list thereof. */ -static OpenedSO* openedSOs = NULL; - -static const char * -internal_dlopen(const char *dll_name) -{ - OpenedSO* o_so; - void *hdl; - const char *errmsg; - char *errmsg_copy; - - // omitted: RTLD_NOW - // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html - IF_DEBUG(linker, - debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name)); - - //-------------- Begin critical section ------------------ - // This critical section is necessary because dlerror() is not - // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008) - // Also, the error message returned must be copied to preserve it - // (see POSIX also) - - ACQUIRE_LOCK(&dl_mutex); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - errmsg = NULL; - if (hdl == NULL) { - /* dlopen failed; return a ptr to the error msg. */ - errmsg = dlerror(); - if (errmsg == NULL) errmsg = "addDLL: unknown error"; - errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL"); - strcpy(errmsg_copy, errmsg); - errmsg = errmsg_copy; - } else { - o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL"); - o_so->handle = hdl; - o_so->next = openedSOs; - openedSOs = o_so; - } - - RELEASE_LOCK(&dl_mutex); - //--------------- End critical section ------------------- - - return errmsg; -} - /* Note [RTLD_LOCAL] ~~~~~~~~~~~~~~~~~ @@ -660,11 +571,10 @@ internal_dlopen(const char *dll_name) static void * internal_dlsym(const char *symbol) { - OpenedSO* o_so; void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -672,20 +582,19 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } - for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) { - v = dlsym(o_so->handle, symbol); - if (dlerror() == NULL) { + for (ObjectCode *nc = loaded_objects; nc; nc = nc->next_loaded_object) { + if (nc->type == DYNAMIC_OBJECT) { + v = dlsym(nc->dlopen_handle, symbol); + if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; + } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -725,79 +634,35 @@ internal_dlsym(const char *symbol) { // we failed to find the symbol return NULL; } -# endif -const char * -addDLL( pathchar *dll_name ) +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - /* ------------------- ELF DLL loader ------------------- */ - -#define NMATCH 5 - regmatch_t match[NMATCH]; - const char *errmsg; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; + ACQUIRE_LOCK(&linker_mutex); - IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name)); - errmsg = internal_dlopen(dll_name); +#if defined(OBJFORMAT_MACHO) + CHECK(symbol_name[0] == '_'); + symbol_name = symbol_name+1; +#endif + void *result = dlsym(handle, symbol_name); - if (errmsg == NULL) { - return NULL; - } + RELEASE_LOCK(&linker_mutex); + return result; +} +# endif - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg)); - result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - return errmsg; // return original error if open fails - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)errmsg); // Free old message before creating new one - errmsg = internal_dlopen(line+match[2].rm_so); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); +const char *addDLL(pathchar* dll_name) +{ +# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + char *errmsg; + if (loadNativeObj(dll_name, &errmsg)) { + return NULL; + } else { + ASSERT(errmsg != NULL); + return errmsg; } - return errmsg; # elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name, NULL); + return addDLL_PEi386(dll_name); # else barf("addDLL: not implemented on this platform"); @@ -1228,10 +1093,10 @@ void freeObjectCode (ObjectCode *oc) } if (oc->type == DYNAMIC_OBJECT) { -#if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); +#if defined(OBJFORMAT_ELF) || defined(darwin_HOST_OS) + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1896,12 +1761,20 @@ HsInt purgeObj (pathchar *path) return r; } +ObjectCode *lookupObjectByPath(pathchar *path) { + for (ObjectCode *o = objects; o; o = o->next) { + if (0 == pathcmp(o->fileName, path)) { + return o; + } + } + return NULL; +} + OStatus getObjectLoadStatus_ (pathchar *path) { - for (ObjectCode *o = objects; o; o = o->next) { - if (0 == pathcmp(o->fileName, path)) { - return o->status; - } + ObjectCode *oc = lookupObjectByPath(path); + if (oc) { + return oc->status; } return OBJECT_NOT_LOADED; } @@ -1988,11 +1861,21 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); + void *r = loadNativeObj_POSIX(path, errmsg); + +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); + } +#endif + RELEASE_LOCK(&linker_mutex); return r; } @@ -2006,7 +1889,7 @@ loadNativeObj (pathchar *path, char **errmsg) } #endif -HsInt unloadNativeObj (void *handle) +static HsInt unloadNativeObj_(void *handle) { bool unloadedAnyObj = false; @@ -2039,11 +1922,18 @@ HsInt unloadNativeObj (void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } +HsInt unloadNativeObj(void *handle) { + ACQUIRE_LOCK(&linker_mutex); + HsInt r = unloadNativeObj_(handle); + RELEASE_LOCK(&linker_mutex); + return r; +} + /* ----------------------------------------------------------------------------- * Segment management */ ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ @@ -515,9 +511,9 @@ HsInt loadArchive_ (pathchar *path); #define USE_CONTIGUOUS_MMAP 0 #endif - HsInt isAlreadyLoaded( pathchar *path ); OStatus getObjectLoadStatus_ (pathchar *path); +ObjectCode *lookupObjectByPath(pathchar *path); HsInt loadOc( ObjectCode* oc ); ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize, bool mapped, pathchar *archiveMemberName, ===================================== rts/RtsSymbols.c ===================================== @@ -619,6 +619,7 @@ extern char **environ; SymI_HasProto(purgeObj) \ SymI_HasProto(insertSymbol) \ SymI_HasProto(lookupSymbol) \ + SymI_HasProto(lookupSymbolInNativeObj) \ SymI_HasDataProto(stg_makeStablePtrzh) \ SymI_HasDataProto(stg_mkApUpd0zh) \ SymI_HasDataProto(stg_labelThreadzh) \ ===================================== rts/include/rts/Linker.h ===================================== @@ -90,8 +90,12 @@ void *loadNativeObj( pathchar *path, char **errmsg ); Takes the handle returned from loadNativeObj() as an argument. */ HsInt unloadNativeObj( void *handle ); +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name); + /* load a dynamic library */ -const char *addDLL( pathchar* dll_name ); +const char *addDLL(pathchar* dll_name); + +void *lookupSymbolInDLL(void *handle, const char *symbol_name); /* add a path to the library search path */ HsPtr addLibrarySearchPath(pathchar* dll_path); ===================================== rts/linker/Elf.c ===================================== @@ -27,11 +27,15 @@ #include "sm/OSMem.h" #include "linker/util.h" #include "linker/elf_util.h" +#include "linker/LoadNativeObjPosix.h" +#include #include #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,159 +2073,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - /* Loading the same object multiple times will lead to chaos - * as we will have two ObjectCodes but one underlying dlopen - * handle. Fail if this happens. - */ - if (getObjectLoadStatus_(path) != OBJECT_NOT_LOADED) { - copyErrmsg(errmsg, "loadNativeObj_ELF: Already loaded"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); - nc->dlopen_handle = hdl; - foreignExportsFinishedLoadingObject(); - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2271,4 +2122,71 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +extern regex_t re_invalid; +extern regex_t re_realso; + +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex); + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,211 @@ +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "LinkerInternals.h" +#include "Rts.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + + ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c ===================================== testsuite/tests/ghci/linking/dyn/T3372.hs ===================================== @@ -1,3 +1,6 @@ +-- Note: This test exercises running concurrent GHCi sessions, but +-- although this test is expected to pass, running concurrent GHCi +-- sessions is currently broken in other ways; see #24345. {-# LANGUAGE MagicHash #-} module Main where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62cb1b8e5ea5b790daa622e9b7b654dd4701d1ab...2d86193a5803a7d820c30ed362e7e67a9aebd121 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62cb1b8e5ea5b790daa622e9b7b654dd4701d1ab...2d86193a5803a7d820c30ed362e7e67a9aebd121 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 16:20:52 2024 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Mon, 01 Apr 2024 12:20:52 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Add todos Message-ID: <660adee45bd74_3a93392007df8505ab@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 61f8c7e4 by Sven Tennie at 2024-04-01T18:19:39+02:00 Add todos - - - - - 2 changed files: - compiler/GHC/CmmToAsm/RV64/Ppr.hs - compiler/GHC/CmmToAsm/RV64/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -26,6 +26,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic +-- TODO: Move function down to where it is used. pprProcAlignment :: IsDoc doc => NCGConfig -> doc pprProcAlignment config = maybe empty (pprAlign platform . mkAlignment) (ncgProcAlignment config) where @@ -78,10 +79,12 @@ pprLabel platform lbl = $$ pprTypeDecl platform lbl $$ line (pprAsmLabel platform lbl <> char ':') +-- TODO: Delete unused parameter. pprAlign :: IsDoc doc => Platform -> Alignment -> doc pprAlign _platform alignment = line $ text "\t.balign " <> int (alignmentBytes alignment) +-- TODO: Delete unused parameters. -- | Print appropriate alignment for the given section type. pprAlignForSection :: IsDoc doc => Platform -> SectionType -> doc pprAlignForSection _platform _seg @@ -97,8 +100,7 @@ pprAlignForSection _platform _seg -- pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc pprSectionAlign _config (Section (OtherSection _) _) = - -- TODO: Valid for RISCV64? - panic "AArch64.Ppr.pprSectionAlign: unknown section" + panic "RV64.Ppr.pprSectionAlign: unknown section" pprSectionAlign config sec@(Section seg _) = line (pprSectionHeader config sec) $$ pprAlignForSection (ncgPlatform config) seg @@ -175,6 +177,7 @@ pprDatas config (CmmStaticsRaw lbl dats) where platform = ncgPlatform config +-- TODO: Unused parameter. pprData :: IsDoc doc => NCGConfig -> CmmStatic -> doc pprData _config (CmmString str) = line (pprString str) pprData _config (CmmFileEmbed path _) = line (pprFileEmbed path) @@ -456,6 +459,7 @@ pprInstr platform instr = case instr of -- 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 + -- TODO: Delete commented out code. -- CMN o1 o2 -> op2 (text "\tcmn") o1 o2 -- CMP o1 o2 -- | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfcmp") o1 o2 @@ -483,9 +487,12 @@ pprInstr platform instr = case instr of DIVU o1 o2 o3 -> op3 (text "\tdivu") o1 o2 o3 -- 2. Bit Manipulation Instructions ------------------------------------------ + -- TODO: Non-existant in RISCV - delete SBFM o1 o2 o3 o4 -> op4 (text "\tsbfm") o1 o2 o3 o4 + -- TODO: Non-existant in RISCV - delete UBFM o1 o2 o3 o4 -> op4 (text "\tubfm") o1 o2 o3 o4 -- signed and unsigned bitfield extract + -- TODO: Non-existant in RISCV - delete UBFX o1 o2 o3 o4 -> op4 (text "\tubfx") o1 o2 o3 o4 -- 3. Logical and Move Instructions ------------------------------------------ @@ -679,6 +686,7 @@ pprInstr platform instr = case instr of 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 + -- TODO: Delete commented out code. -- 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 ===================================== compiler/GHC/CmmToAsm/RV64/Regs.hs ===================================== @@ -121,6 +121,8 @@ allFpArgRegs = map regSingle [fa0RegNo .. fa7RegNo] -- * Addressing modes +-- TODO: AddReg seems to be just a special case of AddrRegImm. Maybe we should +-- replace it with AddrRegImm having an Imm of 0. -- | Addressing modes data AddrMode = -- | A register plus some integer, e.g. @8(sp)@ or @-16(sp)@. The offset View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61f8c7e4a06349df7fe31863ac9791abee2741db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61f8c7e4a06349df7fe31863ac9791abee2741db You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 16:26:17 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 01 Apr 2024 12:26:17 -0400 Subject: [Git][ghc/ghc][wip/T24604] Improvements: handle @a binders too Message-ID: <660ae0297f193_3a933921b2310511c6@gitlab.mail> Simon Peyton Jones pushed to branch wip/T24604 at Glasgow Haskell Compiler / GHC Commits: bf5e0858 by Simon Peyton Jones at 2024-04-01T17:25:44+01:00 Improvements: handle @a binders too - - - - - 5 changed files: - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/vdq-rta/should_fail/T24604.hs - + testsuite/tests/vdq-rta/should_fail/T24604a.hs - + testsuite/tests/vdq-rta/should_fail/T24604a.stderr - testsuite/tests/vdq-rta/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2573,7 +2573,7 @@ kcCheckDeclHeader_sig sig_kind name flav , text "implict_nms:" <+> ppr implicit_nms , text "hs_tv_bndrs:" <+> ppr hs_tv_bndrs ] - ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, (extra_tcbs, tycon_res_kind)))) + ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, skol_scoped_tvs, (extra_tcbs, tycon_res_kind)))) <- pushLevelAndSolveEqualitiesX "kcCheckDeclHeader_sig" $ -- #16687 bindImplicitTKBndrs_Q_Tv implicit_nms $ -- Q means don't clone matchUpSigWithDecl name sig_tcbs sig_res_kind hs_tv_bndrs $ \ excess_sig_tcbs sig_res_kind -> @@ -2625,8 +2625,7 @@ kcCheckDeclHeader_sig sig_kind name flav -- Hence we need to add the visible binders into dup_chk_prs ; implicit_tvs <- liftZonkM $ zonkTcTyVarsToTcTyVars implicit_tvs ; let implicit_prs = implicit_nms `zip` implicit_tvs - dup_chk_prs = implicit_prs ++ - [ (tyVarName tv, tv) | Bndr tv vis <- skol_tcbs, isVisibleTcbVis vis ] + dup_chk_prs = implicit_prs ++ mkTyVarNamePairs skol_scoped_tvs ; unless (null implicit_nms) $ -- No need if no implicit tyvars checkForDuplicateScopedTyVars dup_chk_prs ; checkForDisconnectedScopedTyVars name flav all_tcbs implicit_prs @@ -2697,6 +2696,7 @@ matchUpSigWithDecl -> ([TcTyConBinder] -> TcKind -> TcM a) -- All user-written binders are in scope -- Argument is excess TyConBinders and tail kind -> TcM ( [TcTyConBinder] -- Skolemised binders, with TcTyVars + , [TcTyVar] -- Tyvar brought into lexical scope by this matching-up , a ) -- See Note [Matching a kind signature with a declaration] -- Invariant: Length of returned TyConBinders + length of excess TyConBinders @@ -2707,7 +2707,7 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside go subst tcbs [] = do { let (subst', tcbs') = substTyConBindersX subst tcbs ; res <- thing_inside tcbs' (substTy subst' sig_res_kind) - ; return ([], res) } + ; return ([], [], res) } go _ [] hs_bndrs = failWithTc (TcRnTooManyBinders sig_res_kind hs_bndrs) @@ -2724,18 +2724,19 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside subst' = extendTCvSubstWithClone subst tv tv' ; tc_hs_bndr (unLoc hs_bndr) (tyVarKind tv') ; traceTc "musd1" (ppr tcb $$ ppr hs_bndr $$ ppr tv') - ; (tcbs', res) <- tcExtendTyVarEnv [tv'] $ - go subst' tcbs' hs_bndrs' - ; return (Bndr tv' vis : tcbs', res) } + ; (tcbs', tvs, res) <- tcExtendTyVarEnv [tv'] $ + go subst' tcbs' hs_bndrs' + ; return (Bndr tv' vis : tcbs', tv':tvs, res) } | skippable (binderFlag tcb) = -- Invisible TyConBinder, so do not consume one of the hs_bndrs do { let (subst', tcb') = substTyConBinderX subst tcb ; traceTc "musd2" (ppr tcb $$ ppr hs_bndr $$ ppr tcb') - ; (tcbs', res) <- go subst' tcbs' hs_bndrs + ; (tcbs', tvs, res) <- go subst' tcbs' hs_bndrs -- NB: pass on hs_bndrs unchanged; we do not consume a -- HsTyVarBndr for an invisible TyConBinder - ; return (tcb' : tcbs', res) } + ; return (tcb' : tcbs', tvs, res) } + -- Return `tvs`; no new lexically-scoped TyVars brought into scope | otherwise = -- At this point we conclude that: @@ -2755,9 +2756,13 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. + -- In particular: we match up if + -- (a) HsBndr looks like @k, and TyCon binder is forall k. (NamedTCB Specified) + -- (b) HsBndr looks like a, and TyCon binder is forall k -> (NamedTCB Required) + -- or k -> (AnonTCB) zippable :: TyConBndrVis -> HsBndrVis GhcRn -> Bool - zippable vis (HsBndrRequired _) = isVisibleTcbVis vis - zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis + zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis -- (a) + zippable vis (HsBndrRequired _) = isVisibleTcbVis vis -- (b) -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. ===================================== testsuite/tests/vdq-rta/should_fail/T24604.hs ===================================== @@ -1,6 +1,6 @@ module T24604 where -import Data.Kind (Constraint, Type) +import Data.Kind type UF :: forall zk -> zk -> Constraint class UF kk (xb :: k) where ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeAbstractions #-} + +module T24604a where + +import Data.Kind + +type UF :: forall zk. zk -> Constraint +class UF @kk (xb :: k) where + op :: (xs::kk) -> Bool ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.stderr ===================================== @@ -0,0 +1,4 @@ + +T24604a.hs:8:11: error: [GHC-17370] + • Different names for the same type variable: ‘k’ and ‘kk’ + • In the class declaration for ‘UF’ ===================================== testsuite/tests/vdq-rta/should_fail/all.T ===================================== @@ -19,3 +19,4 @@ test('T24176', normal, compile_fail, ['']) test('T23739_fail_ret', normal, compile_fail, ['']) test('T23739_fail_case', normal, compile_fail, ['']) test('T24604', normal, compile_fail, ['']) +test('T24604a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf5e08589e240d49c50b695959d0382c4fbae47f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf5e08589e240d49c50b695959d0382c4fbae47f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 16:31:57 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 01 Apr 2024 12:31:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T24462 Message-ID: <660ae17d18546_3a933922b8110517dc@gitlab.mail> Simon Peyton Jones pushed new branch wip/T24462 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T24462 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 16:37:12 2024 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 01 Apr 2024 12:37:12 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/invis-pats-change-ast] Change how invisible patterns represented in haskell syntax and TH AST (#24557) Message-ID: <660ae2b8a07a6_3a933923ba644536ed@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/invis-pats-change-ast at Glasgow Haskell Compiler / GHC Commits: 349f83e7 by Andrei Borzenkov at 2024-04-01T20:36:51+04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Functor.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 - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Zonk/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/349f83e7989acfe19cc485fe80677ce1d94ad5b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/349f83e7989acfe19cc485fe80677ce1d94ad5b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 17:44:26 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 Apr 2024 13:44:26 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 4 commits: Drop me: Start writing test Message-ID: <660af27a83abe_3a93392b501ec570de@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: ba4d6428 by Rodrigo Mesquita at 2024-04-01T17:16:09+01:00 Drop me: Start writing test It works now, but is not a good test to add because it relies on timing... - - - - - ca5e00f2 by Alexis King at 2024-04-01T17:54:14+01:00 linker: Avoid linear search when looking up Haskell symbols via dlsym See the primary Note [Looking up symbols in the relevant objects] for a more in-depth explanation. When dynamically loading a Haskell symbol (typical when running a splice or GHCi expression), before this commit we would search for the symbol in all dynamic libraries that were loaded. However, this could be very inefficient when too many packages are loaded (which can happen if there are many package dependencies) because the time to lookup the would be linear in the number of packages loaded. This commit drastically improves symbol loading performance by introducing a mapping from units to the handles of corresponding loaded dlls. These handles are returned by dlopen when we load a dll, and can then be used to look up in a specific dynamic library. Looking up a given Name is now much more precise because we can get lookup its unit in the mapping and lookup the symbol solely in the handles of the dynamic libraries loaded for that unit. In one measurement, the wait time before the expression was executed went from +-38 seconds down to +-2s. This commit also includes Note [Symbols may not be found in pkgs_loaded], explaining the fallback to the old behaviour in case no dll can be found in the unit mapping for a given Name. Fixes #23415 Co-authored-by: Rodrigo Mesquita (@alt-romes) - - - - - 3fb11d24 by Rodrigo Mesquita at 2024-04-01T17:54:14+01:00 rts: Make addDLL a wrapper around loadNativeObj Rewrite the implementation of `addDLL` as a wrapper around the more principled `loadNativeObj` rts linker function. The latter should be preferred while the former is preserved for backwards compatibility. `loadNativeObj` was previously only available on ELF platforms, so this commit further refactors the rts linker to transform loadNativeObj_ELF into loadNativeObj_POSIX, which is available in ELF and MachO platforms. The refactor made it possible to remove the `dl_mutex` mutex in favour of always using `linker_mutex` (rather than a combination of both). Lastly, we implement `loadNativeObj` for Windows too. - - - - - 0ba67d90 by Rodrigo Mesquita at 2024-04-01T17:54:14+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 29 changed files: - + T23415/Makefile - + T23415/main.hs - + T23415/make_shared_libs.sh - + T23415/new-main.hs - + T23415/run_test.sh - compiler/GHC.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/MacOS.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/ObjLink.hs - libraries/ghci/GHCi/Run.hs - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/include/rts/Linker.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/rts.cabal - testsuite/tests/ghci/linking/dyn/T3372.hs - testsuite/tests/rts/linker/T2615.hs Changes: ===================================== T23415/Makefile ===================================== @@ -0,0 +1,10 @@ +.PHONY: run build clean + +run: + sh run_test.sh + +build: + sh make_shared_libs.sh + +clean: + rm -f lib*.out main main.o main.hi test.o tags ===================================== T23415/main.hs ===================================== @@ -0,0 +1,20 @@ +import Control.Monad +import System.FilePath +import System.Directory +import GHCi.ObjLink + +hsLoadObjs = do + cwd <- getCurrentDirectory + forM_ [0..499] $ \i -> + loadDLL (cwd "lib" ++ show i ++ ".out") + +hsLoadSymbols = do + forM_ [0..99] $ \j -> + forM_ [0..499] $ \i -> + lookupSymbol ("lib" ++ show i ++ "_" ++ show j) + +main = do + initObjLinker RetainCAFs + hsLoadObjs + hsLoadSymbols + ===================================== T23415/make_shared_libs.sh ===================================== @@ -0,0 +1,20 @@ +#!/bin/sh + +example_dylib=$(basename -- $(find $(ghc --print-libdir) -name libHS* -not -name *.a | head -n1)) +dylib_ext="${example_dylib##*.}" +# we try .out instead of using the correct extension. + +i=0 +while [ $i -lt 500 ]; do + j=0 + while [ $j -lt 100 ]; do + echo "int lib${i}_$j(void) { return $i; }" >> "lib$i.c" + j=$(( j + 1 )) + done + cc -o "lib$i.o" -c "lib$i.c" -fPIC + cc -shared "lib$i.o" -o "lib$i.out" # "lib$i.$dylib_ext" + rm "lib$i.c" "lib$i.o" + i=$(( i + 1 )) +done + + ===================================== T23415/new-main.hs ===================================== @@ -0,0 +1,29 @@ +import Data.Either +import Data.Foldable +import Data.Map as M +import Control.Monad +import System.FilePath +import System.Directory +import GHCi.ObjLink + +libname i = "lib" ++ show i + +hsLoadObjs = do + cwd <- getCurrentDirectory + foldrM (\i acc -> do + Right handle <- loadDLL (cwd libname i ++ ".out") + return $ M.insert (libname i) handle acc + ) + M.empty [0..499] + +hsLoadSymbols handles = do + forM_ [0..499] $ \i -> + forM_ [0..99] $ \j -> do + let symbolname = libname i ++ "_" ++ show j + lookupSymbolInDLL (handles M.! libname i) symbolname + +main = do + initObjLinker RetainCAFs + handles <- hsLoadObjs + hsLoadSymbols handles + print "hi" ===================================== T23415/run_test.sh ===================================== @@ -0,0 +1,8 @@ +#!/bin/sh + +GHC1=/Users/romes/ghc-dev/ghc/_build/stage1/bin/ghc +GHC2=/Users/romes/ghc-dev/23415/_build/stage1/bin/ghc + +# $GHC1 --interactive main.hs -package directory -package ghci -package filepath +$GHC2 --interactive new-main.hs -package directory -package ghci -package filepath -package containers + ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -24,6 +24,7 @@ import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHC.Builtin.PrimOps +import GHC.Builtin.PrimOps.Ids import GHC.Builtin.Names import GHC.Unit.Types @@ -38,6 +39,8 @@ import GHC.Utils.Outputable import GHC.Types.Name import GHC.Types.Name.Env +import qualified GHC.Types.Id as Id +import GHC.Types.Unique.DFM import Language.Haskell.Syntax.Module.Name @@ -52,31 +55,32 @@ import GHC.Exts linkBCO :: Interp + -> PkgsLoaded -> LinkerEnv -> NameEnv Int -> UnlinkedBCO -> IO ResolvedBCO -linkBCO interp le bco_ix +linkBCO interp pkgs_loaded le bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - lits <- mapM (fmap fromIntegral . lookupLiteral interp le) (ssElts lits0) - ptrs <- mapM (resolvePtr interp le bco_ix) (ssElts ptrs0) + lits <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (ssElts lits0) + ptrs <- mapM (resolvePtr interp pkgs_loaded le bco_ix) (ssElts ptrs0) return (ResolvedBCO isLittleEndian arity insns bitmap (listArray (0, fromIntegral (sizeSS lits0)-1) lits) (addListToSS emptySS ptrs)) -lookupLiteral :: Interp -> LinkerEnv -> BCONPtr -> IO Word -lookupLiteral interp le ptr = case ptr of +lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word +lookupLiteral interp pkgs_loaded le ptr = case ptr of BCONPtrWord lit -> return lit BCONPtrLbl sym -> do Ptr a# <- lookupStaticPtr interp sym return (W# (int2Word# (addr2Int# a#))) BCONPtrItbl nm -> do - Ptr a# <- lookupIE interp (itbl_env le) nm + Ptr a# <- lookupIE interp pkgs_loaded (itbl_env le) nm return (W# (int2Word# (addr2Int# a#))) BCONPtrAddr nm -> do - Ptr a# <- lookupAddr interp (addr_env le) nm + Ptr a# <- lookupAddr interp pkgs_loaded (addr_env le) nm return (W# (int2Word# (addr2Int# a#))) BCONPtrStr _ -> -- should be eliminated during assembleBCOs @@ -90,19 +94,19 @@ lookupStaticPtr interp addr_of_label_string = do Nothing -> linkFail "GHC.ByteCode.Linker: can't find label" (unpackFS addr_of_label_string) -lookupIE :: Interp -> ItblEnv -> Name -> IO (Ptr ()) -lookupIE interp ie con_nm = +lookupIE :: Interp -> PkgsLoaded -> ItblEnv -> Name -> IO (Ptr ()) +lookupIE interp pkgs_loaded ie con_nm = case lookupNameEnv ie con_nm of Just (_, ItblPtr a) -> return (fromRemotePtr (castRemotePtr a)) Nothing -> do -- try looking up in the object files. let sym_to_find1 = nameToCLabel con_nm "con_info" - m <- lookupSymbol interp sym_to_find1 + m <- lookupHsSymbol interp pkgs_loaded con_nm "con_info" case m of Just addr -> return addr Nothing -> do -- perhaps a nullary constructor? let sym_to_find2 = nameToCLabel con_nm "static_info" - n <- lookupSymbol interp sym_to_find2 + n <- lookupHsSymbol interp pkgs_loaded con_nm "static_info" case n of Just addr -> return addr Nothing -> linkFail "GHC.ByteCode.Linker.lookupIE" @@ -110,34 +114,35 @@ lookupIE interp ie con_nm = unpackFS sym_to_find2) -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode -lookupAddr :: Interp -> AddrEnv -> Name -> IO (Ptr ()) -lookupAddr interp ae addr_nm = do +lookupAddr :: Interp -> PkgsLoaded -> AddrEnv -> Name -> IO (Ptr ()) +lookupAddr interp pkgs_loaded ae addr_nm = do case lookupNameEnv ae addr_nm of Just (_, AddrPtr ptr) -> return (fromRemotePtr ptr) Nothing -> do -- try looking up in the object files. let sym_to_find = nameToCLabel addr_nm "bytes" -- see Note [Bytes label] in GHC.Cmm.CLabel - m <- lookupSymbol interp sym_to_find + m <- lookupHsSymbol interp pkgs_loaded addr_nm "bytes" case m of Just ptr -> return ptr Nothing -> linkFail "GHC.ByteCode.Linker.lookupAddr" (unpackFS sym_to_find) -lookupPrimOp :: Interp -> PrimOp -> IO (RemotePtr ()) -lookupPrimOp interp primop = do +lookupPrimOp :: Interp -> PkgsLoaded -> PrimOp -> IO (RemotePtr ()) +lookupPrimOp interp pkgs_loaded primop = do let sym_to_find = primopToCLabel primop "closure" - m <- lookupSymbol interp (mkFastString sym_to_find) + m <- lookupHsSymbol interp pkgs_loaded (Id.idName $ primOpId primop) "closure" case m of Just p -> return (toRemotePtr p) Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE(primop)" sym_to_find resolvePtr :: Interp + -> PkgsLoaded -> LinkerEnv -> NameEnv Int -> BCOPtr -> IO ResolvedBCOPtr -resolvePtr interp le bco_ix ptr = case ptr of +resolvePtr interp pkgs_loaded le bco_ix ptr = case ptr of BCOPtrName nm | Just ix <- lookupNameEnv bco_ix nm -> return (ResolvedBCORef ix) -- ref to another BCO in this group @@ -149,20 +154,38 @@ resolvePtr interp le bco_ix ptr = case ptr of -> assertPpr (isExternalName nm) (ppr nm) $ do let sym_to_find = nameToCLabel nm "closure" - m <- lookupSymbol interp sym_to_find + m <- lookupHsSymbol interp pkgs_loaded nm "closure" case m of Just p -> return (ResolvedBCOStaticPtr (toRemotePtr p)) Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE" (unpackFS sym_to_find) BCOPtrPrimOp op - -> ResolvedBCOStaticPtr <$> lookupPrimOp interp op + -> ResolvedBCOStaticPtr <$> lookupPrimOp interp pkgs_loaded op BCOPtrBCO bco - -> ResolvedBCOPtrBCO <$> linkBCO interp le bco_ix bco + -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le bco_ix bco BCOPtrBreakArray breakarray -> withForeignRef breakarray $ \ba -> return (ResolvedBCOPtrBreakArray ba) +lookupHsSymbol :: Interp -> PkgsLoaded -> Name -> String -> IO (Maybe (Ptr ())) +lookupHsSymbol interp pkgs_loaded nm sym_suffix = do + massertPpr (isExternalName nm) (ppr nm) + let sym_to_find = nameToCLabel nm sym_suffix + pkg_id = moduleUnitId $ nameModule nm + loaded_dlls = maybe [] loaded_pkg_hs_dlls $ lookupUDFM pkgs_loaded pkg_id + + go (dll:dlls) = do + mb_ptr <- lookupSymbolInDLL interp dll sym_to_find + case mb_ptr of + Just ptr -> pure (Just ptr) + Nothing -> go dlls + go [] = + -- See Note [Symbols may not be found in pkgs_loaded] in GHC.Linker.Types + lookupSymbol interp sym_to_find + + go loaded_dlls + linkFail :: String -> String -> IO a linkFail who what = throwGhcExceptionIO (ProgramError $ ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -420,12 +420,12 @@ loadExternalPluginLib :: FilePath -> IO () loadExternalPluginLib path = do -- load library loadDLL path >>= \case - Just errmsg -> pprPanic "loadExternalPluginLib" - (vcat [ text "Can't load plugin library" - , text " Library path: " <> text path - , text " Error : " <> text errmsg - ]) - Nothing -> do + Left errmsg -> pprPanic "loadExternalPluginLib" + (vcat [ text "Can't load plugin library" + , text " Library path: " <> text path + , text " Error : " <> text errmsg + ]) + Right _ -> do -- TODO: use returned LoadedDLL? -- resolve objects resolveObjs >>= \case True -> return () ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Tc.Utils.Monad import GHC.Runtime.Interpreter import GHCi.RemoteTypes import GHC.Iface.Load +import GHCi.Message (LoadedDLL) import GHC.ByteCode.Linker import GHC.ByteCode.Asm @@ -172,7 +173,7 @@ emptyLoaderState = LoaderState -- -- The linker's symbol table is populated with RTS symbols using an -- explicit list. See rts/Linker.c for details. - where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqDSet) + where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] [] emptyUniqDSet) extendLoadedEnv :: Interp -> [(Name,ForeignHValue)] -> IO () extendLoadedEnv interp new_bindings = @@ -221,8 +222,8 @@ loadDependencies -> SrcSpan -> [Module] -> IO (LoaderState, SuccessFlag, [Linkable], PkgsLoaded) -- ^ returns the set of linkables required +-- When called, the loader state must have been initialized (see `initLoaderState`) loadDependencies interp hsc_env pls span needed_mods = do --- initLoaderState (hsc_dflags hsc_env) dl let opts = initLinkDepsOpts hsc_env -- Find what packages and linkables are required @@ -512,25 +513,25 @@ preloadLib interp hsc_env lib_paths framework_paths pls lib_spec = do DLL dll_unadorned -> do maybe_errstr <- loadDLL interp (platformSOName platform dll_unadorned) case maybe_errstr of - Nothing -> maybePutStrLn logger "done" - Just mm | platformOS platform /= OSDarwin -> + Right _ -> maybePutStrLn logger "done" + Left mm | platformOS platform /= OSDarwin -> preloadFailed mm lib_paths lib_spec - Just mm | otherwise -> do + Left mm | otherwise -> do -- As a backup, on Darwin, try to also load a .so file -- since (apparently) some things install that way - see -- ticket #8770. let libfile = ("lib" ++ dll_unadorned) <.> "so" err2 <- loadDLL interp libfile case err2 of - Nothing -> maybePutStrLn logger "done" - Just _ -> preloadFailed mm lib_paths lib_spec + Right _ -> maybePutStrLn logger "done" + Left _ -> preloadFailed mm lib_paths lib_spec return pls DLLPath dll_path -> do do maybe_errstr <- loadDLL interp dll_path case maybe_errstr of - Nothing -> maybePutStrLn logger "done" - Just mm -> preloadFailed mm lib_paths lib_spec + Right _ -> maybePutStrLn logger "done" + Left mm -> preloadFailed mm lib_paths lib_spec return pls Framework framework -> @@ -614,7 +615,7 @@ loadExpr interp hsc_env span root_ul_bco = do -- Load the necessary packages and linkables let le = linker_env pls bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)] - resolved <- linkBCO interp le bco_ix root_ul_bco + resolved <- linkBCO interp (pkgs_loaded pls) le bco_ix root_ul_bco [root_hvref] <- createBCOs interp [resolved] fhv <- mkFinalizedHValue interp root_hvref return (pls, fhv) @@ -678,7 +679,7 @@ loadDecls interp hsc_env span cbc at CompiledByteCode{..} = do , addr_env = plusNameEnv (addr_env le) bc_strs } -- Link the necessary packages and linkables - new_bindings <- linkSomeBCOs interp le2 [cbc] + new_bindings <- linkSomeBCOs interp (pkgs_loaded pls) le2 [cbc] nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings let ce2 = extendClosureEnv (closure_env le2) nms_fhvs !pls2 = pls { linker_env = le2 { closure_env = ce2 } } @@ -860,8 +861,8 @@ dynLoadObjs interp hsc_env pls at LoaderState{..} objs = do changeTempFilesLifetime tmpfs TFL_GhcSession [soFile] m <- loadDLL interp soFile case m of - Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } - Just err -> linkFail msg err + Right _ -> return $! pls { temp_sos = (libPath, libName) : temp_sos } + Left err -> linkFail msg err where msg = "GHC.Linker.Loader.dynLoadObjs: Loading temp shared object failed" @@ -901,7 +902,7 @@ dynLinkBCOs interp pls bcos = do ae2 = foldr plusNameEnv (addr_env le1) (map bc_strs cbcs) le2 = le1 { itbl_env = ie2, addr_env = ae2 } - names_and_refs <- linkSomeBCOs interp le2 cbcs + names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs -- We only want to add the external ones to the ClosureEnv let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs @@ -916,6 +917,7 @@ dynLinkBCOs interp pls bcos = do -- Link a bunch of BCOs and return references to their values linkSomeBCOs :: Interp + -> PkgsLoaded -> LinkerEnv -> [CompiledByteCode] -> IO [(Name,HValueRef)] @@ -923,7 +925,7 @@ linkSomeBCOs :: Interp -- the incoming unlinked BCOs. Each gives the -- value of the corresponding unlinked BCO -linkSomeBCOs interp le mods = foldr fun do_link mods [] +linkSomeBCOs interp pkgs_loaded le mods = foldr fun do_link mods [] where fun CompiledByteCode{..} inner accum = inner (bc_bcos : accum) @@ -932,7 +934,7 @@ linkSomeBCOs interp le mods = foldr fun do_link mods [] let flat = [ bco | bcos <- mods, bco <- bcos ] names = map unlinkedBCOName flat bco_ix = mkNameEnv (zip names [0..]) - resolved <- sequence [ linkBCO interp le bco_ix bco | bco <- flat ] + resolved <- sequence [ linkBCO interp pkgs_loaded le bco_ix bco | bco <- flat ] hvrefs <- createBCOs interp resolved return (zip names hvrefs) @@ -1094,18 +1096,18 @@ loadPackages' interp hsc_env new_pks pls = do -- Link dependents first ; pkgs' <- link pkgs deps -- Now link the package itself - ; (hs_cls, extra_cls) <- loadPackage interp hsc_env pkg_cfg + ; (hs_cls, extra_cls, loaded_dlls) <- loadPackage interp hsc_env pkg_cfg ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg | dep_pkg <- deps , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) ] - ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls trans_deps)) } + ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls loaded_dlls trans_deps)) } | otherwise = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (unitIdFS new_pkg))) -loadPackage :: Interp -> HscEnv -> UnitInfo -> IO ([LibrarySpec], [LibrarySpec]) +loadPackage :: Interp -> HscEnv -> UnitInfo -> IO ([LibrarySpec], [LibrarySpec], [RemotePtr LoadedDLL]) loadPackage interp hsc_env pkg = do let dflags = hsc_dflags hsc_env @@ -1147,7 +1149,9 @@ loadPackage interp hsc_env pkg let classifieds = hs_classifieds ++ extra_classifieds -- Complication: all the .so's must be loaded before any of the .o's. - let known_dlls = [ dll | DLLPath dll <- classifieds ] + let known_hs_dlls = [ dll | DLLPath dll <- hs_classifieds ] + known_extra_dlls = [ dll | DLLPath dll <- extra_classifieds ] + known_dlls = known_hs_dlls ++ known_extra_dlls #if defined(CAN_LOAD_DLL) dlls = [ dll | DLL dll <- classifieds ] #endif @@ -1168,10 +1172,13 @@ loadPackage interp hsc_env pkg loadFrameworks interp platform pkg -- See Note [Crash early load_dyn and locateLib] -- Crash early if can't load any of `known_dlls` - mapM_ (load_dyn interp hsc_env True) known_dlls + mapM_ (load_dyn interp hsc_env True) known_extra_dlls + loaded_dlls <- mapMaybeM (load_dyn interp hsc_env True) known_hs_dlls -- For remaining `dlls` crash early only when there is surely -- no package's DLL around ... (not is_dyn) mapM_ (load_dyn interp hsc_env (not is_dyn) . platformSOName platform) dlls +#else + let loaded_dlls = [] #endif -- After loading all the DLLs, we can load the static objects. -- Ordering isn't important here, because we do one final link @@ -1191,7 +1198,7 @@ loadPackage interp hsc_env pkg if succeeded ok then do maybePutStrLn logger "done." - return (hs_classifieds, extra_classifieds) + return (hs_classifieds, extra_classifieds, loaded_dlls) else let errmsg = text "unable to load unit `" <> pprUnitInfoForUser pkg <> text "'" in throwGhcExceptionIO (InstallationError (showSDoc dflags errmsg)) @@ -1244,19 +1251,20 @@ restriction very easily. -- can be passed directly to loadDLL. They are either fully-qualified -- ("/usr/lib/libfoo.so"), or unqualified ("libfoo.so"). In the latter case, -- loadDLL is going to search the system paths to find the library. -load_dyn :: Interp -> HscEnv -> Bool -> FilePath -> IO () +load_dyn :: Interp -> HscEnv -> Bool -> FilePath -> IO (Maybe (RemotePtr LoadedDLL)) load_dyn interp hsc_env crash_early dll = do r <- loadDLL interp dll case r of - Nothing -> return () - Just err -> + Right loaded_dll -> pure (Just loaded_dll) + Left err -> if crash_early then cmdLineErrorIO err - else + else do when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts) $ logMsg logger (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing) noSrcSpan $ withPprStyle defaultUserStyle (note err) + pure Nothing where diag_opts = initDiagOpts (hsc_dflags hsc_env) logger = hsc_logger hsc_env ===================================== compiler/GHC/Linker/MacOS.hs ===================================== @@ -172,6 +172,6 @@ loadFramework interp extraPaths rootname findLoadDLL (p:ps) errs = do { dll <- loadDLL interp (p fwk_file) ; case dll of - Nothing -> return Nothing - Just err -> findLoadDLL ps ((p ++ ": " ++ err):errs) + Right _ -> return Nothing + Left err -> findLoadDLL ps ((p ++ ": " ++ err):errs) } ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -40,7 +40,8 @@ import GHC.Prelude import GHC.Unit ( UnitId, Module ) import GHC.ByteCode.Types ( ItblEnv, AddrEnv, CompiledByteCode ) import GHC.Fingerprint.Type ( Fingerprint ) -import GHCi.RemoteTypes ( ForeignHValue ) +import GHCi.RemoteTypes ( ForeignHValue, RemotePtr ) +import GHCi.Message ( LoadedDLL ) import GHC.Types.Var ( Id ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnvList, filterNameEnv ) @@ -75,6 +76,56 @@ initialised. The LinkerEnv maps Names to actual closures (for interpreted code only), for use during linking. + +Note [Looking up symbols in the relevant objects] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In #23415, we determined that a lot of time (>10s, or even up to >35s!) was +being spent on dynamically loading symbols before actually interpreting code +when `:main` was run in GHCi. The root cause was that for each symbol we wanted +to lookup, we would traverse the list of loaded objects and try find the symbol +in each of them with dlsym (i.e. looking up a symbol was, worst case, linear in +the amount of loaded objects). + +To drastically improve load time (from +-38 seconds down to +-2s), we now: + +1. For every of the native objects loaded for a given unit, store the handles returned by `dlopen`. + - In `pkgs_loaded` of the `LoaderState`, which maps `UnitId`s to + `LoadedPkgInfo`s, where the handles live in its field `loaded_pkg_hs_dlls`. + +2. When looking up a Name (e.g. `lookupHsSymbol`), find that name's `UnitId` in + the `pkgs_loaded` mapping, + +3. And only look for the symbol (with `dlsym`) on the /handles relevant to that + unit/, rather than in every loaded object. + +Note [Symbols may not be found in pkgs_loaded] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Despite storing and looking for symbols in the relevant loaded libraries +handles for a given unit-id, as described in the note above, we may still have +to fallback to the "slow" `lookupSymbol` function (see its "fallback" call in +`lookupHsSymbol`). + +TODO: Ben: my understanding here is flawed; could you make this clearer?. + +This fallback is still needed because a given unit may be associated with +static objects (`loaded_pkg_hs_objs`) only and no dynamic libraries, but we +only `lookupSymbolInDLL` for loaded dynamic libraries. In that case, +`lookupSymbol` will do the right thing because, besides looking up the symbol +in every loaded dylib, it will end up searching the static name table and find those symbols. + +Arguably, we should rather generalise `lookupSymbolInDLL` to +`lookupSymbolInObject`, where an object may be a DLL/native object (as in +`loadNativeObj`), or e.g. a static archive, instead of having a special case +for dynamic libraries. + +This fallback is further needed because we don't look in the haskell objects +loaded for the home units (see the call to `loadModuleLinkables` in +`loadDependencies`, as opposed to the call to `loadPackages'` in the same +function which updates `pkgs_loaded`). We should ultimately keep track of the +objects loaded (probably in `objs_loaded`, for which `LinkableSet` is a bit +unsatisfactory, see a suggestion in 51c5c4eb1f2a33e4dc88e6a37b7b7c135234ce9b) +and be able to lookup symbols specifically in them too (similarly to +`lookupSymbolInDLL`). -} newtype Loader = Loader { loader_state :: MVar (Maybe LoaderState) } @@ -146,11 +197,13 @@ data LoadedPkgInfo { loaded_pkg_uid :: !UnitId , loaded_pkg_hs_objs :: ![LibrarySpec] , loaded_pkg_non_hs_objs :: ![LibrarySpec] + , loaded_pkg_hs_dlls :: ![RemotePtr LoadedDLL] + -- ^ See Note [Looking up symbols in the relevant objects] , loaded_pkg_trans_deps :: UniqDSet UnitId } instance Outputable LoadedPkgInfo where - ppr (LoadedPkgInfo uid hs_objs non_hs_objs trans_deps) = + ppr (LoadedPkgInfo uid hs_objs non_hs_objs _ trans_deps) = vcat [ppr uid , ppr hs_objs , ppr non_hs_objs @@ -159,10 +212,10 @@ instance Outputable LoadedPkgInfo where -- | Information we can use to dynamically link modules into the compiler data Linkable = LM { - linkableTime :: !UTCTime, -- ^ Time at which this linkable was built + linkableTime :: !UTCTime, -- ^ Time at which this linkable was built -- (i.e. when the bytecodes were produced, -- or the mod date on the files) - linkableModule :: !Module, -- ^ The linkable module itself + linkableModule :: !Module, -- ^ The linkable module itself linkableUnlinked :: [Unlinked] -- ^ Those files and chunks of code we have yet to link. -- ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -35,6 +35,7 @@ module GHC.Runtime.Interpreter -- * The object-code linker , initObjLinker , lookupSymbol + , lookupSymbolInDLL , lookupClosure , loadDLL , loadArchive @@ -151,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -440,57 +441,78 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + +lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of +#if defined(HAVE_INTERNAL_INTERPRETER) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) +#endif + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either -- an absolute pathname to the file, or a relative filename -- (e.g. "libfoo.so" or "foo.dll"). In the latter case, loadDLL -- searches the standard locations for the appropriate library. --- --- Returns: --- --- Nothing => success --- Just err_msg => failure -loadDLL :: Interp -> String -> IO (Maybe String) +loadDLL :: Interp -> String -> IO (Either String (RemotePtr LoadedDLL)) loadDLL interp str = interpCmd interp (LoadDLL str) loadArchive :: Interp -> String -> IO () @@ -549,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -23,6 +23,7 @@ module GHCi.Message , getMessage, putMessage, getTHMessage, putTHMessage , Pipe(..), remoteCall, remoteTHCall, readPipe, writePipe , BreakModule + , LoadedDLL ) where import Prelude -- See note [Why do we import Prelude here?] @@ -73,8 +74,9 @@ data Message a where -- These all invoke the corresponding functions in the RTS Linker API. InitLinker :: Message () LookupSymbol :: String -> Message (Maybe (RemotePtr ())) + LookupSymbolInDLL :: RemotePtr LoadedDLL -> String -> Message (Maybe (RemotePtr ())) LookupClosure :: String -> Message (Maybe HValueRef) - LoadDLL :: String -> Message (Maybe String) + LoadDLL :: String -> Message (Either String (RemotePtr LoadedDLL)) LoadArchive :: String -> Message () -- error? LoadObj :: String -> Message () -- error? UnloadObj :: String -> Message () -- error? @@ -415,6 +417,9 @@ instance Binary a => Binary (EvalResult a) -- that type isn't available here. data BreakModule +-- | A dummy type that tags pointers returned by 'LoadDLL'. +data LoadedDLL + -- SomeException can't be serialized because it contains dynamic -- types. However, we do very limited things with the exceptions that -- are thrown by interpreted computations: @@ -544,6 +549,7 @@ getMessage = do 37 -> Msg <$> return RtsRevertCAFs 38 -> Msg <$> (ResumeSeq <$> get) 39 -> Msg <$> (NewBreakModule <$> get) + 40 -> Msg <$> (LookupSymbolInDLL <$> get <*> get) _ -> error $ "Unknown Message code " ++ (show b) putMessage :: Message a -> Put @@ -588,7 +594,8 @@ putMessage m = case m of Seq a -> putWord8 36 >> put a RtsRevertCAFs -> putWord8 37 ResumeSeq a -> putWord8 38 >> put a - NewBreakModule name -> putWord8 39 >> put name + NewBreakModule name -> putWord8 39 >> put name + LookupSymbolInDLL dll str -> putWord8 40 >> put dll >> put str {- Note [Parallelize CreateBCOs serialization] ===================================== libraries/ghci/GHCi/ObjLink.hs ===================================== @@ -18,6 +18,7 @@ module GHCi.ObjLink , unloadObj , purgeObj , lookupSymbol + , lookupSymbolInDLL , lookupClosure , resolveObjs , addLibrarySearchPath @@ -27,18 +28,17 @@ module GHCi.ObjLink import Prelude -- See note [Why do we import Prelude here?] import GHCi.RemoteTypes +import GHCi.Message (LoadedDLL) import Control.Exception (throwIO, ErrorCall(..)) import Control.Monad ( when ) import Foreign.C -import Foreign.Marshal.Alloc ( free ) -import Foreign ( nullPtr ) +import Foreign.Marshal.Alloc ( alloca, free ) +import Foreign ( nullPtr, peek ) import GHC.Exts import System.Posix.Internals ( CFilePath, withFilePath, peekFilePath ) import System.FilePath ( dropExtension, normalise ) - - -- --------------------------------------------------------------------------- -- RTS Linker Interface -- --------------------------------------------------------------------------- @@ -70,6 +70,15 @@ lookupSymbol str_in = do then return Nothing else return (Just addr) +lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a)) +lookupSymbolInDLL dll str_in = do + let str = prefixUnderscore str_in + withCAString str $ \c_str -> do + addr <- c_lookupSymbolInNativeObj dll c_str + if addr == nullPtr + then return Nothing + else return (Just addr) + lookupClosure :: String -> IO (Maybe HValueRef) lookupClosure str = do m <- lookupSymbol str @@ -89,7 +98,7 @@ prefixUnderscore -- (e.g. "libfoo.so" or "foo.dll"). In the latter case, loadDLL -- searches the standard locations for the appropriate library. -- -loadDLL :: String -> IO (Maybe String) +loadDLL :: String -> IO (Either String (Ptr LoadedDLL)) -- Nothing => success -- Just err_msg => failure loadDLL str0 = do @@ -101,12 +110,16 @@ loadDLL str0 = do str | isWindowsHost = dropExtension str0 | otherwise = str0 -- - maybe_errmsg <- withFilePath (normalise str) $ \dll -> c_addDLL dll - if maybe_errmsg == nullPtr - then return Nothing - else do str <- peekCString maybe_errmsg - free maybe_errmsg - return (Just str) + (maybe_handle, maybe_errmsg) <- withFilePath (normalise str) $ \dll -> + alloca $ \errmsg_ptr -> (,) + <$> c_loadNativeObj dll errmsg_ptr + <*> peek errmsg_ptr + + if maybe_handle == nullPtr + then do str <- peekCString maybe_errmsg + free maybe_errmsg + return (Left str) + else return (Right maybe_handle) loadArchive :: String -> IO () loadArchive str = do @@ -163,7 +176,8 @@ resolveObjs = do -- Foreign declarations to RTS entry points which does the real work; -- --------------------------------------------------------------------------- -foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> IO CString +foreign import ccall unsafe "loadNativeObj" c_loadNativeObj :: CFilePath -> Ptr CString -> IO (Ptr LoadedDLL) +foreign import ccall unsafe "lookupSymbolInNativeObj" c_lookupSymbolInNativeObj :: Ptr LoadedDLL -> CString -> IO (Ptr a) foreign import ccall unsafe "initLinker_" c_initLinker_ :: CInt -> IO () foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -66,7 +66,7 @@ run m = case m of LookupClosure str -> lookupJSClosure str #else InitLinker -> initObjLinker RetainCAFs - LoadDLL str -> loadDLL str + LoadDLL str -> fmap toRemotePtr <$> loadDLL str LoadArchive str -> loadArchive str LoadObj str -> loadObj str UnloadObj str -> unloadObj str @@ -81,6 +81,8 @@ run m = case m of #endif RtsRevertCAFs -> rts_revertCAFs LookupSymbol str -> fmap toRemotePtr <$> lookupSymbol str + LookupSymbolInDLL dll str -> + fmap toRemotePtr <$> lookupSymbolInDLL (fromRemotePtr dll) str FreeHValueRefs rs -> mapM_ freeRemoteRef rs AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr EvalStmt opts r -> evalStmt opts r ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInDLL) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -417,11 +421,8 @@ static int linker_init_done = 0 ; #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) static void *dl_prog_handle; -static regex_t re_invalid; -static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif +regex_t re_invalid; +regex_t re_realso; #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -556,90 +551,6 @@ exitLinker( void ) { # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -/* Suppose in ghci we load a temporary SO for a module containing - f = 1 - and then modify the module, recompile, and load another temporary - SO with - f = 2 - Then as we don't unload the first SO, dlsym will find the - f = 1 - symbol whereas we want the - f = 2 - symbol. We therefore need to keep our own SO handle list, and - try SOs in the right order. */ - -typedef - struct _OpenedSO { - struct _OpenedSO* next; - void *handle; - } - OpenedSO; - -/* A list thereof. */ -static OpenedSO* openedSOs = NULL; - -static const char * -internal_dlopen(const char *dll_name) -{ - OpenedSO* o_so; - void *hdl; - const char *errmsg; - char *errmsg_copy; - - // omitted: RTLD_NOW - // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html - IF_DEBUG(linker, - debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name)); - - //-------------- Begin critical section ------------------ - // This critical section is necessary because dlerror() is not - // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008) - // Also, the error message returned must be copied to preserve it - // (see POSIX also) - - ACQUIRE_LOCK(&dl_mutex); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - errmsg = NULL; - if (hdl == NULL) { - /* dlopen failed; return a ptr to the error msg. */ - errmsg = dlerror(); - if (errmsg == NULL) errmsg = "addDLL: unknown error"; - errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL"); - strcpy(errmsg_copy, errmsg); - errmsg = errmsg_copy; - } else { - o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL"); - o_so->handle = hdl; - o_so->next = openedSOs; - openedSOs = o_so; - } - - RELEASE_LOCK(&dl_mutex); - //--------------- End critical section ------------------- - - return errmsg; -} - /* Note [RTLD_LOCAL] ~~~~~~~~~~~~~~~~~ @@ -660,11 +571,10 @@ internal_dlopen(const char *dll_name) static void * internal_dlsym(const char *symbol) { - OpenedSO* o_so; void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -672,20 +582,19 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } - for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) { - v = dlsym(o_so->handle, symbol); - if (dlerror() == NULL) { + for (ObjectCode *nc = loaded_objects; nc; nc = nc->next_loaded_object) { + if (nc->type == DYNAMIC_OBJECT) { + v = dlsym(nc->dlopen_handle, symbol); + if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; + } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -725,79 +634,35 @@ internal_dlsym(const char *symbol) { // we failed to find the symbol return NULL; } -# endif -const char * -addDLL( pathchar *dll_name ) +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - /* ------------------- ELF DLL loader ------------------- */ - -#define NMATCH 5 - regmatch_t match[NMATCH]; - const char *errmsg; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; + ACQUIRE_LOCK(&linker_mutex); - IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name)); - errmsg = internal_dlopen(dll_name); +#if defined(OBJFORMAT_MACHO) + CHECK(symbol_name[0] == '_'); + symbol_name = symbol_name+1; +#endif + void *result = dlsym(handle, symbol_name); - if (errmsg == NULL) { - return NULL; - } + RELEASE_LOCK(&linker_mutex); + return result; +} +# endif - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg)); - result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - return errmsg; // return original error if open fails - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)errmsg); // Free old message before creating new one - errmsg = internal_dlopen(line+match[2].rm_so); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); +const char *addDLL(pathchar* dll_name) +{ +# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + char *errmsg; + if (loadNativeObj(dll_name, &errmsg)) { + return NULL; + } else { + ASSERT(errmsg != NULL); + return errmsg; } - return errmsg; # elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name, NULL); + return addDLL_PEi386(dll_name); # else barf("addDLL: not implemented on this platform"); @@ -1228,10 +1093,10 @@ void freeObjectCode (ObjectCode *oc) } if (oc->type == DYNAMIC_OBJECT) { -#if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); +#if defined(OBJFORMAT_ELF) || defined(darwin_HOST_OS) + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1896,12 +1761,20 @@ HsInt purgeObj (pathchar *path) return r; } +ObjectCode *lookupObjectByPath(pathchar *path) { + for (ObjectCode *o = objects; o; o = o->next) { + if (0 == pathcmp(o->fileName, path)) { + return o; + } + } + return NULL; +} + OStatus getObjectLoadStatus_ (pathchar *path) { - for (ObjectCode *o = objects; o; o = o->next) { - if (0 == pathcmp(o->fileName, path)) { - return o->status; - } + ObjectCode *oc = lookupObjectByPath(path); + if (oc) { + return oc->status; } return OBJECT_NOT_LOADED; } @@ -1988,11 +1861,21 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); + void *r = loadNativeObj_POSIX(path, errmsg); + +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); + } +#endif + RELEASE_LOCK(&linker_mutex); return r; } @@ -2006,7 +1889,7 @@ loadNativeObj (pathchar *path, char **errmsg) } #endif -HsInt unloadNativeObj (void *handle) +static HsInt unloadNativeObj_(void *handle) { bool unloadedAnyObj = false; @@ -2039,11 +1922,18 @@ HsInt unloadNativeObj (void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } +HsInt unloadNativeObj(void *handle) { + ACQUIRE_LOCK(&linker_mutex); + HsInt r = unloadNativeObj_(handle); + RELEASE_LOCK(&linker_mutex); + return r; +} + /* ----------------------------------------------------------------------------- * Segment management */ ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ @@ -515,9 +511,9 @@ HsInt loadArchive_ (pathchar *path); #define USE_CONTIGUOUS_MMAP 0 #endif - HsInt isAlreadyLoaded( pathchar *path ); OStatus getObjectLoadStatus_ (pathchar *path); +ObjectCode *lookupObjectByPath(pathchar *path); HsInt loadOc( ObjectCode* oc ); ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize, bool mapped, pathchar *archiveMemberName, ===================================== rts/RtsSymbols.c ===================================== @@ -619,6 +619,7 @@ extern char **environ; SymI_HasProto(purgeObj) \ SymI_HasProto(insertSymbol) \ SymI_HasProto(lookupSymbol) \ + SymI_HasProto(lookupSymbolInNativeObj) \ SymI_HasDataProto(stg_makeStablePtrzh) \ SymI_HasDataProto(stg_mkApUpd0zh) \ SymI_HasDataProto(stg_labelThreadzh) \ ===================================== rts/include/rts/Linker.h ===================================== @@ -90,8 +90,12 @@ void *loadNativeObj( pathchar *path, char **errmsg ); Takes the handle returned from loadNativeObj() as an argument. */ HsInt unloadNativeObj( void *handle ); +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name); + /* load a dynamic library */ -const char *addDLL( pathchar* dll_name ); +const char *addDLL(pathchar* dll_name); + +void *lookupSymbolInDLL(void *handle, const char *symbol_name); /* add a path to the library search path */ HsPtr addLibrarySearchPath(pathchar* dll_path); ===================================== rts/linker/Elf.c ===================================== @@ -27,11 +27,15 @@ #include "sm/OSMem.h" #include "linker/util.h" #include "linker/elf_util.h" +#include "linker/LoadNativeObjPosix.h" +#include #include #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,159 +2073,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - /* Loading the same object multiple times will lead to chaos - * as we will have two ObjectCodes but one underlying dlopen - * handle. Fail if this happens. - */ - if (getObjectLoadStatus_(path) != OBJECT_NOT_LOADED) { - copyErrmsg(errmsg, "loadNativeObj_ELF: Already loaded"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); - nc->dlopen_handle = hdl; - foreignExportsFinishedLoadingObject(); - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2271,4 +2122,71 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +extern regex_t re_invalid; +extern regex_t re_realso; + +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex); + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,211 @@ +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "LinkerInternals.h" +#include "Rts.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + + ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c ===================================== testsuite/tests/ghci/linking/dyn/T3372.hs ===================================== @@ -1,3 +1,6 @@ +-- Note: This test exercises running concurrent GHCi sessions, but +-- although this test is expected to pass, running concurrent GHCi +-- sessions is currently broken in other ways; see #24345. {-# LANGUAGE MagicHash #-} module Main where ===================================== testsuite/tests/rts/linker/T2615.hs ===================================== @@ -6,5 +6,5 @@ main = do initObjLinker RetainCAFs result <- loadDLL library_name case result of - Nothing -> putStrLn (library_name ++ " loaded successfully") - Just x -> putStrLn ("error: " ++ x) + Right _ -> putStrLn (library_name ++ " loaded successfully") + Left x -> putStrLn ("error: " ++ x) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d86193a5803a7d820c30ed362e7e67a9aebd121...0ba67d90e6af52e2a564cac74c902828f8fc05a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d86193a5803a7d820c30ed362e7e67a9aebd121...0ba67d90e6af52e2a564cac74c902828f8fc05a9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 19:12:23 2024 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Mon, 01 Apr 2024 15:12:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/unicode-splice Message-ID: <660b071721187_3a933935450d0598e0@gitlab.mail> Oleg Grenrus pushed new branch wip/unicode-splice at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/unicode-splice You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Apr 1 22:35:29 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 01 Apr 2024 18:35:29 -0400 Subject: [Git][ghc/ghc][wip/T24463] 2 commits: Clone in CorePrep Message-ID: <660b36b1392ee_3a93394c57cc8670f4@gitlab.mail> Simon Peyton Jones pushed to branch wip/T24463 at Glasgow Haskell Compiler / GHC Commits: 710ef4fa by Simon Peyton Jones at 2024-04-01T23:06:15+01:00 Clone in CorePrep - - - - - 4c445c97 by Simon Peyton Jones at 2024-04-01T23:33:55+01:00 Wibble - - - - - 3 changed files: - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg/Prep.hs Changes: ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Core.TyCo.Subst extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet, extendTCvSubst, extendTCvSubstWithClone, extendCvSubst, extendCvSubstWithClone, - extendTvSubst, extendTvSubstBinderAndInScope, extendTvSubstWithClone, + extendTvSubst, extendTvSubstWithClone, extendTvSubstList, extendTvSubstAndInScope, extendTCvSubstList, unionSubst, zipTyEnv, zipCoEnv, @@ -372,13 +372,6 @@ extendTvSubst (Subst in_scope ids tvs cvs) tv ty = assert (isTyVar tv) $ Subst in_scope ids (extendVarEnv tvs tv ty) cvs -extendTvSubstBinderAndInScope :: Subst -> PiTyBinder -> Type -> Subst -extendTvSubstBinderAndInScope subst (Named (Bndr v _)) ty - = assert (isTyVar v ) - extendTvSubstAndInScope subst v ty -extendTvSubstBinderAndInScope subst (Anon {}) _ - = subst - extendTvSubstWithClone :: Subst -> TyVar -> TyVar -> Subst -- Adds a new tv -> tv mapping, /and/ extends the in-scope set with the clone -- Does not look in the kind of the new variable; ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -205,8 +205,7 @@ module GHC.Core.Type ( zapSubst, getSubstInScope, setInScope, getSubstRangeTyCoFVs, extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet, extendTCvSubst, extendCvSubst, - extendTvSubst, extendTvSubstBinderAndInScope, - extendTvSubstList, extendTvSubstAndInScope, + extendTvSubst, extendTvSubstList, extendTvSubstAndInScope, extendTCvSubstList, extendTvSubstWithClone, extendTCvSubstWithClone, ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Core.Utils import GHC.Core.Opt.Arity import GHC.Core.Lint ( EndPassConfig(..), endPassIO ) import GHC.Core +import GHC.Core.Subst import GHC.Core.Make hiding( FloatBind(..) ) -- We use our own FloatBind here import GHC.Core.Type import GHC.Core.Coercion @@ -56,7 +57,6 @@ import GHC.Utils.Logger import GHC.Types.Demand import GHC.Types.Var -import GHC.Types.Var.Env import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Id.Make ( realWorldPrimId ) @@ -763,10 +763,10 @@ cpeRhsE :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs) -- For example -- f (g x) ===> ([v = g x], f v) -cpeRhsE _ (Type ty) - = return (emptyFloats, Type ty) -cpeRhsE _ (Coercion co) - = return (emptyFloats, Coercion co) +cpeRhsE env (Type ty) + = return (emptyFloats, Type (cpSubstTy env ty)) +cpeRhsE env (Coercion co) + = return (emptyFloats, Coercion (cpSubstCo env co)) cpeRhsE env expr@(Lit lit) | LitNumber LitNumBigNat i <- lit = cpeBigNatLit env i @@ -799,7 +799,7 @@ cpeRhsE env (Tick tickish expr) cpeRhsE env (Cast expr co) = do { (floats, expr') <- cpeRhsE env expr - ; return (floats, Cast expr' co) } + ; return (floats, Cast expr' (cpSubstCo env co)) } cpeRhsE env expr@(Lam {}) = do { let (bndrs,body) = collectBinders expr @@ -807,7 +807,7 @@ cpeRhsE env expr@(Lam {}) ; body' <- cpeBodyNF env' body ; return (emptyFloats, mkLams bndrs' body') } -cpeRhsE env (Case scrut bndr _ alts@[Alt con bs _]) +cpeRhsE env (Case scrut bndr _ alts@[Alt con [covar] _]) -- See (U3) in Note [Implementing unsafeCoerce] -- We need make the Case float, otherwise we get -- let x = case ... of UnsafeRefl co -> @@ -823,14 +823,14 @@ cpeRhsE env (Case scrut bndr _ alts@[Alt con bs _]) -- (such as `print003`). | Just rhs <- isUnsafeEqualityCase scrut bndr alts = do { (floats_scrut, scrut) <- cpeBody env scrut - ; (env, bndr) <- cpCloneBndr env bndr - ; (env, bs) <- cpCloneBndrs env bs + ; (env, bndr') <- cpCloneBndr env bndr + ; (env, covar') <- cpCloneCoVarBndr env covar -- Up until here this should do exactly the same as the regular code -- path of `cpeRhsE Case{}`. ; (floats_rhs, rhs) <- cpeBody env rhs -- ... but we want to float `floats_rhs` as in (U3) so that rhs' might -- become a value - ; let case_float = UnsafeEqualityCase scrut bndr con bs + ; let case_float = UnsafeEqualityCase scrut bndr' con [covar'] -- NB: It is OK to "evaluate" the proof eagerly. -- Usually there's the danger that we float the unsafeCoerce out of -- a branching Case alt. Not so here, because the regular code path @@ -849,7 +849,7 @@ cpeRhsE env (Case scrut bndr ty alts) where err = mkImpossibleExpr ty "cpeRhsE: missing case alternative" ; alts'' <- mapM (sat_alt env') alts' - ; return (floats, Case scrut' bndr2 ty alts'') } + ; return (floats, Case scrut' bndr2 (cpSubstTy env ty) alts'') } where sat_alt env (Alt con bs rhs) = do { (env2, bs') <- cpCloneBndrs env bs @@ -1184,10 +1184,14 @@ cpeApp top_env expr in rebuild_app' env (a : as) tick_fun floats ss rt_ticks req_depth CpeApp (Type arg_ty) - -> rebuild_app' env as (App fun' (Type arg_ty)) floats ss rt_ticks req_depth + -> rebuild_app' env as (App fun' (Type arg_ty')) floats ss rt_ticks req_depth + where + arg_ty' = cpSubstTy env arg_ty CpeApp (Coercion co) - -> rebuild_app' env as (App fun' (Coercion co)) floats (drop 1 ss) rt_ticks req_depth + -> rebuild_app' env as (App fun' (Coercion co')) floats (drop 1 ss) rt_ticks req_depth + where + co' = cpSubstCo env co CpeApp arg -> do let (ss1, ss_rest) -- See Note [lazyId magic] in GHC.Types.Id.Make @@ -1199,7 +1203,10 @@ cpeApp top_env expr rebuild_app' env as (App fun' arg') (fs `zipFloats` floats) ss_rest rt_ticks (req_depth-1) CpeCast co - -> rebuild_app' env as (Cast fun' co) floats ss rt_ticks req_depth + -> rebuild_app' env as (Cast fun' co') floats ss rt_ticks req_depth + where + co' = cpSubstCo env co + -- See Note [Ticks and mandatory eta expansion] CpeTick tickish | tickishPlace tickish == PlaceRuntime @@ -2220,6 +2227,7 @@ binding for data constructors; see Note [Data constructor workers]. Note [CorePrep inlines trivial CoreExpr not Id] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +TODO Why does cpe_env need to be an IdEnv CoreExpr, as opposed to an IdEnv Id? Naively, we might conjecture that trivial updatable thunks as per Note [Inlining in CorePrep] always have the form @@ -2259,8 +2267,8 @@ data CorePrepEnv -- the case where a function we think should bottom -- unexpectedly returns. - , cpe_env :: IdEnv CoreExpr -- Clone local Ids - -- ^ This environment is used for three operations: + , cpe_subst :: Subst + -- ^ The IdEnv part of the substitution is used for three operations: -- -- 1. To support cloning of local Ids so that they are -- all unique (see item (6) of CorePrep overview). @@ -2271,6 +2279,9 @@ data CorePrepEnv -- 3. To let us inline trivial RHSs of non top-level let-bindings, -- see Note [lazyId magic], Note [Inlining in CorePrep] -- and Note [CorePrep inlines trivial CoreExpr not Id] (#12076) + -- + -- The TyCoVar part of the substitution is used only for + -- Note [UnsafeEqualityProof] , cpe_rec_ids :: UnVarSet -- Faster OutIdSet; See Note [Speculative evaluation] } @@ -2278,33 +2289,48 @@ data CorePrepEnv mkInitialCorePrepEnv :: CorePrepConfig -> CorePrepEnv mkInitialCorePrepEnv cfg = CPE { cpe_config = cfg - , cpe_env = emptyVarEnv + , cpe_subst = emptySubst , cpe_rec_ids = emptyUnVarSet } extendCorePrepEnv :: CorePrepEnv -> Id -> Id -> CorePrepEnv -extendCorePrepEnv cpe id id' - = cpe { cpe_env = extendVarEnv (cpe_env cpe) id (Var id') } +extendCorePrepEnv cpe@(CPE { cpe_subst = subst }) id id' + = cpe { cpe_subst = subst2 } + where + subst1 = extendSubstInScope subst id' + subst2 = extendIdSubst subst1 id (Var id') + +extendCorePrepEnvList :: CorePrepEnv -> [(Id,Id)] -> CorePrepEnv +extendCorePrepEnvList cpe@(CPE { cpe_subst = subst }) prs + = cpe { cpe_subst = subst2 } + where + subst1 = extendSubstInScopeList subst (map snd prs) + subst2 = extendIdSubstList subst1 [(id, Var id') | (id,id') <- prs] extendCorePrepEnvExpr :: CorePrepEnv -> Id -> CoreExpr -> CorePrepEnv extendCorePrepEnvExpr cpe id expr - = cpe { cpe_env = extendVarEnv (cpe_env cpe) id expr } - -extendCorePrepEnvList :: CorePrepEnv -> [(Id,Id)] -> CorePrepEnv -extendCorePrepEnvList cpe prs - = cpe { cpe_env = extendVarEnvList (cpe_env cpe) - (map (\(id, id') -> (id, Var id')) prs) } + = cpe { cpe_subst = extendIdSubst (cpe_subst cpe) id expr } lookupCorePrepEnv :: CorePrepEnv -> Id -> CoreExpr lookupCorePrepEnv cpe id - = case lookupVarEnv (cpe_env cpe) id of - Nothing -> Var id - Just exp -> exp + = case lookupIdSubst_maybe (cpe_subst cpe) id of + Just e -> e + Nothing -> Var id + -- Do not use GHC.Core.Subs.lookupIdSubst because that is a no-op on GblIds; + -- and Tidy has made top-level externally-visible Ids into GblIds enterRecGroupRHSs :: CorePrepEnv -> [OutId] -> CorePrepEnv enterRecGroupRHSs env grp = env { cpe_rec_ids = extendUnVarSetList grp (cpe_rec_ids env) } +cpSubstTy :: CorePrepEnv -> Type -> Type +cpSubstTy (CPE { cpe_subst = subst }) ty = substTy subst ty + -- substTy has a short-cut if the TCvSubst is empty + +cpSubstCo :: CorePrepEnv -> Coercion -> Coercion +cpSubstCo (CPE { cpe_subst = subst }) co = substCo subst co + -- substCo has a short-cut if the TCvSubst is empty + ------------------------------------------------------------------------------ -- Cloning binders -- --------------------------------------------------------------------------- @@ -2312,12 +2338,29 @@ enterRecGroupRHSs env grp cpCloneBndrs :: CorePrepEnv -> [InVar] -> UniqSM (CorePrepEnv, [OutVar]) cpCloneBndrs env bs = mapAccumLM cpCloneBndr env bs +cpCloneCoVarBndr :: CorePrepEnv -> InVar -> UniqSM (CorePrepEnv, OutVar) +cpCloneCoVarBndr env@(CPE { cpe_subst = subst }) covar + = assertPpr (isCoVar covar) (ppr covar) $ + do { uniq <- getUniqueM + ; let covar1 = setVarUnique covar uniq + covar2 = updateVarType (substTy subst) covar1 + subst1 = extendTCvSubstWithClone subst covar covar2 + ; return (env { cpe_subst = subst1 }, covar2) } + cpCloneBndr :: CorePrepEnv -> InVar -> UniqSM (CorePrepEnv, OutVar) -cpCloneBndr env bndr +-- See Note [CorePrep Overview] point (6) +cpCloneBndr env@(CPE { cpe_subst = subst }) bndr | isTyCoVar bndr - = return (env, bndr) - | otherwise - = do { bndr' <- clone_it bndr + = if isEmptyTCvSubst subst + then return (env, bndr) -- The common case + else -- No need to clone the Unique; but apply the substitution + let bndr1 = updateVarType (substTy subst) bndr + subst1 = extendTCvSubstWithClone subst bndr bndr1 + in return (env { cpe_subst = subst1 }, bndr1) + + | otherwise -- A non-CoVar Id + = do { bndr1 <- clone_it bndr + ; let bndr2 = updateIdTypeAndMult (substTy subst) bndr1 -- Drop (now-useless) rules/unfoldings -- See Note [Drop unfoldings and rules] @@ -2327,10 +2370,10 @@ cpCloneBndr env bndr ; let !unfolding' = trimUnfolding (realIdUnfolding bndr) -- Simplifier will set the Id's unfolding - bndr'' = bndr' `setIdUnfolding` unfolding' - `setIdSpecialisation` emptyRuleInfo + bndr3 = bndr2 `setIdUnfolding` unfolding' + `setIdSpecialisation` emptyRuleInfo - ; return (extendCorePrepEnv env bndr bndr'', bndr'') } + ; return (extendCorePrepEnv env bndr bndr3, bndr3) } where clone_it bndr | isLocalId bndr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42237c9f9094c0b9527d4884c559e1282724cea0...4c445c97492dfe9a5d12fb2b13d4291a4daa30c2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42237c9f9094c0b9527d4884c559e1282724cea0...4c445c97492dfe9a5d12fb2b13d4291a4daa30c2 You're receiving 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 Apr 2 02:42:28 2024 From: gitlab at gitlab.haskell.org (Brandon Chinn (@brandonchinn178)) Date: Mon, 01 Apr 2024 22:42:28 -0400 Subject: [Git][ghc/ghc][wip/multiline-strings] 54 commits: Fix sharing of 'IfaceTyConInfo' during core to iface type translation Message-ID: <660b70946db9_1c6b478585444293@gitlab.mail> Brandon Chinn pushed to branch wip/multiline-strings at Glasgow Haskell Compiler / GHC Commits: 73be65ab by Fendor at 2024-03-19T01:42:53-04:00 Fix sharing of 'IfaceTyConInfo' during core to iface type translation During heap analysis, we noticed that during generation of 'mi_extra_decls' we have lots of duplicates for the instances: * `IfaceTyConInfo NotPromoted IfaceNormalTyCon` * `IfaceTyConInfo IsPromoted IfaceNormalTyCon` which should be shared instead of duplicated. This duplication increased the number of live bytes by around 200MB while loading the agda codebase into GHCi. These instances are created during `CoreToIface` translation, in particular `toIfaceTyCon`. The generated core looks like: toIfaceTyCon = \ tc_sjJw -> case $wtoIfaceTyCon tc_sjJw of { (# ww_sjJz, ww1_sjNL, ww2_sjNM #) -> IfaceTyCon ww_sjJz (IfaceTyConInfo ww1_sjNL ww2_sjNM) } whichs removes causes the sharing to work propery. Adding explicit sharing, with NOINLINE annotations, changes the core to: toIfaceTyCon = \ tc_sjJq -> case $wtoIfaceTyCon tc_sjJq of { (# ww_sjNB, ww1_sjNC #) -> IfaceTyCon ww_sjNB ww1_sjNC } which looks much more like sharing is happening. We confirmed via ghc-debug that all duplications were eliminated and the number of live bytes are noticeably reduced. - - - - - bd8209eb by Alan Zimmerman at 2024-03-19T01:43:28-04:00 EPA: Address more 9.10.1-alpha1 regressions from recent changes Closes #24533 Hopefully for good this time - - - - - 31bf85ee by Fendor at 2024-03-19T14:48:08-04:00 Escape multiple arguments in the settings file Uses responseFile syntax. The issue arises when GHC is installed on windows into a location that has a space, for example the user name is 'Fake User'. The $topdir will also contain a space, consequentially. When we resolve the top dir in the string `-I$topdir/mingw/include`, then `words` will turn this single argument into `-I/C/Users/Fake` and `User/.../mingw/include` which trips up the flag argument parser of various tools such as gcc or clang. We avoid this by escaping the $topdir before replacing it in `initSettngs`. Additionally, we allow to escape spaces and quotation marks for arguments in `settings` file. Add regression test case to count the number of options after variable expansion and argument escaping took place. Additionally, we check that escaped spaces and double quotation marks are correctly parsed. - - - - - f45f700e by Matthew Pickering at 2024-03-19T14:48:44-04:00 Read global package database from settings file Before this patch, the global package database was always assumed to be in libdir </> package.conf.d. This causes issues in GHC's build system because there are sometimes situations where the package database you need to use is not located in the same place as the settings file. * The stage1 compiler needs to use stage1 libraries, so we should set "Global Package DB" for the stage1 compiler to the stage1 package database. * Stage 2 cross compilers need to use stage2 libraries, so likewise, we should set the package database path to `_build/stage2/lib/` * The normal situation is where the stage2 compiler uses stage1 libraries. Then everything lines up. * When installing we have rearranged everything so that the settings file and package database line up properly, so then everything should continue to work as before. In this case we set the relative package db path to `package.conf.d`, so it resolves the same as before. * ghc-pkg needs to be modified as well to look in the settings file fo the package database rather than assuming the global package database location relative to the lib folder. * Cabal/cabal-install will work correctly because they query the global package database using `--print-global-package-db`. A reasonable question is why not generate the "right" settings files in the right places in GHC's build system. In order to do this you would need to engineer wrappers for all executables to point to a specific libdir. There are also situations where the same package db is used by two different compilers with two different settings files (think stage2 cross compiler and stage3 compiler). In short, this 10 line patch allows for some reasonable simplifications in Hadrian at very little cost to anything else. Fixes #24502 - - - - - 4c8f1794 by Matthew Pickering at 2024-03-19T14:48:44-04:00 hadrian: Remove stage1 testsuite wrappers logic Now instead of producing wrappers which pass the global package database argument to ghc and ghc-pkg, we write the location of the correct package database into the settings file so you can just use the intree compiler directly. - - - - - da0d8ba5 by Matthew Craven at 2024-03-19T14:49:20-04:00 Remove unused ghc-internal module "GHC.Internal.Constants" - - - - - b56d2761 by Matthew Craven at 2024-03-19T14:49:20-04:00 CorePrep: Rework lowering of BigNat# literals Don't use bigNatFromWord#, because that's terrible: * We shouldn't have to traverse a linked list at run-time to build a BigNat# literal. That's just silly! * The static List object we have to create is much larger than the actual BigNat#'s contents, bloating code size. * We have to read the corresponding interface file, which causes un-tracked implicit dependencies. (#23942) Instead, encode them into the appropriate platform-dependent sequence of bytes, and generate code that copies these bytes at run-time from an Addr# literal into a new ByteArray#. A ByteArray# literal would be the correct thing to generate, but these are not yet supported; see also #17747. Somewhat surprisingly, this change results in a slight reduction in compiler allocations, averaging around 0.5% on ghc's compiler performance tests, including when compiling programs that contain no bignum literals to begin with. The specific cause of this has not been investigated. Since this lowering no longer reads the interface file for GHC.Num.BigNat, the reasoning in Note [Depend on GHC.Num.Integer] is obsoleted. But the story of un-tracked built-in dependencies remains complex, and Note [Tracking dependencies on primitives] now exists to explain this complexity. Additionally, many empty imports have been modified to refer to this new note and comply with its guidance. Several empty imports necessary for other reasons have also been given brief explanations. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 349ea330 by Fendor at 2024-03-19T14:50:00-04:00 Eliminate thunk in 'IfaceTyCon' Heap analysis showed that `IfaceTyCon` retains a thunk to `IfaceTyConInfo`, defeating the sharing of the most common instances of `IfaceTyConInfo`. We make sure the indirection is removed by adding bang patterns to `IfaceTyCon`. Experimental results on the agda code base, where the `mi_extra_decls` were read from disk: Before this change, we observe around 8654045 instances of: `IfaceTyCon[Name,THUNK_1_0]` But these thunks almost exclusively point to a shared value! Forcing the thunk a little bit more, leads to `ghc-debug` reporting: `IfaceTyCon[Name:Name,IfaceTyConInfo]` and a noticeable reduction of live bytes (on agda ~10%). - - - - - 594bee0b by Krzysztof Gogolewski at 2024-03-19T14:50:36-04:00 Minor misc cleanups - GHC.HsToCore.Foreign.JavaScript: remove dropRuntimeRepArgs; boxed tuples don't take RuntimeRep args - GHC.HsToCore.Foreign.Call: avoid partial pattern matching - GHC.Stg.Unarise: strengthen the assertion; we can assert that non-rubbish literals are unary rather than just non-void - GHC.Tc.Gen.HsType: make sure the fsLit "literal" rule fires - users_guide/using-warnings.rst: remove -Wforall-identifier, now deprecated and does nothing - users_guide/using.rst: fix formatting - andy_cherry/test.T: remove expect_broken_for(23272...), 23272 is fixed The rest are simple cleanups. - - - - - cf55a54b by Ben Gamari at 2024-03-19T14:51:12-04:00 mk/relpath: Fix quoting Previously there were two instances in this script which lacked proper quoting. This resulted in `relpath` invocations in the binary distribution Makefile producing incorrect results on Windows, leading to confusing failures from `sed` and the production of empty package registrations. Fixes #24538. - - - - - 5ff88389 by Bryan Richter at 2024-03-19T14:51:48-04:00 testsuite: Disable T21336a on wasm - - - - - 60023351 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian/bindist: Eliminate extraneous `dirname` invocation Previously we would call `dirname` twice per installed library file. We now instead reuse this result. This helps appreciably on Windows, where processes are quite expensive. - - - - - 616ac300 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian: Package mingw toolchain in expected location This fixes #24525, a regression due to 41cbaf44a6ab5eb9fa676d65d32df8377898dc89. Specifically, GHC expects to find the mingw32 toolchain in the binary distribution root. However, after this patch it was packaged in the `lib/` directory. - - - - - de9daade by Ben Gamari at 2024-03-19T22:33:11-04:00 gitlab/rel_eng: More upload.sh tweaks - - - - - 1dfe12db by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_eng: Drop dead prepare_docs codepath - - - - - dd2d748b by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_env/recompress_all: unxz before recompressing Previously we would rather compress the xz *again*, before in addition compressing it with the desired scheme. Fixes #24545. - - - - - 9d936c57 by Ben Gamari at 2024-03-19T22:33:11-04:00 mk-ghcup-metadata: Fix directory of testsuite tarball As reported in #24546, the `dlTest` artifact should be extracted into the `testsuite` directory. - - - - - 6d398066 by Ben Gamari at 2024-03-19T22:33:11-04:00 ghcup-metadata: Don't populate dlOutput unless necessary ghcup can apparently infer the output name of an artifact from its URL. Consequently, we should only include the `dlOutput` field when it would differ from the filename of `dlUri`. Fixes #24547. - - - - - 576f8b7e by Zubin Duggal at 2024-03-19T22:33:46-04:00 Revert "Apply shellcheck suggestion to SUBST_TOOLDIR" This reverts commit c82770f57977a2b5add6e1378f234f8dd6153392. The shellcheck suggestion is spurious and results in SUBST_TOOLDIR being a no-op. `set` sets positional arguments for bash, but we want to set the variable given as the first autoconf argument. Fixes #24542 Metric decreases because the paths in the settings file are now shorter, so we allocate less when we read the settings file. ------------------------- Metric Decrease: T12425 T13035 T9198 ------------------------- - - - - - cdfe6e01 by Fendor at 2024-03-19T22:34:22-04:00 Compact serialisation of IfaceAppArgs In #24563, we identified that IfaceAppArgs serialisation tags each cons cell element with a discriminator byte. These bytes add up quickly, blowing up interface files considerably when '-fwrite-if-simplified-core' is enabled. We compact the serialisation by writing out the length of 'IfaceAppArgs', followed by serialising the elements directly without any discriminator byte. This improvement can decrease the size of some interface files by up to 35%. - - - - - 97a2bb1c by Simon Peyton Jones at 2024-03-20T17:11:29+00:00 Expand untyped splices in tcPolyExprCheck Fixes #24559 - - - - - 5f275176 by Alan Zimmerman at 2024-03-20T22:44:12-04:00 EPA: Clean up Exactprint helper functions a bit - Introduce a helper lens to compose on `EpAnn a` vs `a` versions - Rename some prime versions of functions back to non-prime They were renamed during the rework - - - - - da2a10ce by Vladislav Zavialov at 2024-03-20T22:44:48-04:00 Type operators in promoteOccName (#24570) Type operators differ from term operators in that they are lexically classified as (type) constructors, not as (type) variables. Prior to this change, promoteOccName did not account for this difference, causing a scoping issue that affected RequiredTypeArguments. type (!@#) = Bool f = idee (!@#) -- Not in scope: ‘!@#’ (BUG) Now we have a special case in promoteOccName to account for this. - - - - - 247fc0fa by Preetham Gujjula at 2024-03-21T10:19:18-04:00 docs: Remove mention of non-existent Ord instance for Complex The documentation for Data.Complex says that the Ord instance for Complex Float is deficient, but there is no Ord instance for Complex a. The Eq instance for Complex Float is similarly deficient, so we use that as an example instead. - - - - - 6fafc51e by Andrei Borzenkov at 2024-03-21T10:19:54-04:00 Fix TH handling in `pat_to_type_pat` function (#24571) There was missing case for `SplicePat` in `pat_to_type_at` function, hence patterns with splicing that checked against `forall->` doesn't work properly because they fall into the "illegal pattern" case. Code example that is now accepted: g :: forall a -> () g $([p| a |]) = () - - - - - 52072f8e by Sylvain Henry at 2024-03-21T21:01:59-04:00 Type-check default declarations before deriving clauses (#24566) See added Note and #24566. Default declarations must be type-checked before deriving clauses. - - - - - 7dfdf3d9 by Sylvain Henry at 2024-03-21T21:02:40-04:00 Lexer: small perf changes - Use unsafeChr because we know our values to be valid - Remove some unnecessary use of `ord` (return Word8 values directly) - - - - - 864922ef by Sylvain Henry at 2024-03-21T21:02:40-04:00 JS: fix some comments - - - - - 3e0b2b1f by Sebastian Graf at 2024-03-21T21:03:16-04:00 Simplifier: Re-do dependency analysis in abstractFloats (#24551) In #24551, we abstracted a string literal binding over a type variable, triggering a CoreLint error when that binding floated to top-level. The solution implemented in this patch fixes this by re-doing dependency analysis on a simplified recursive let binding that is about to be type abstracted, in order to find the minimal set of type variables to abstract over. See wrinkle (AB5) of Note [Floating and type abstraction] for more details. Fixes #24551 - - - - - 8a8ac65a by Matthew Craven at 2024-03-23T00:20:52-04:00 Improve toInteger @Word32 on 64-bit platforms On 64-bit platforms, every Word32 fits in an Int, so we can convert to Int# without having to perform the overflow check integerFromWord# uses internally. - - - - - 0c48f2b9 by Apoorv Ingle at 2024-03-23T00:21:28-04:00 Fix for #24552 (see testcase T24552) Fixes for a bug in desugaring pattern synonyms matches, introduced while working on on expanding `do`-blocks in #18324 The `matchWrapper` unecessarily (and incorrectly) filtered out the default wild patterns in a match. Now the wild pattern alternative is simply ignored by the pm check as its origin is `Generated`. The current code now matches the expected semantics according to the language spec. - - - - - b72705e9 by Simon Peyton Jones at 2024-03-23T00:22:04-04:00 Print more info about kinds in error messages This fixes #24553, where GHC unhelpfully said error: [GHC-83865] • Expected kind ‘* -> * -> *’, but ‘Foo’ has kind ‘* -> * -> *’ See Note [Showing invisible bits of types in error messages] - - - - - 8f7cfc7e by Tristan Cacqueray at 2024-03-23T00:22:44-04:00 docs: remove the don't use float hint This hint is outdated, ``Complex Float`` are now specialised, and the heap space suggestion needs more nuance so it should be explained in the unboxed/storable array documentation. - - - - - 5bd8ed53 by Andreas Klebinger at 2024-03-23T16:18:33-04:00 NCG: Fix a bug in jump shortcutting. When checking if a jump has more than one destination account for the possibility of some jumps not being representable by a BlockId. We do so by having isJumpishInstr return a `Maybe BlockId` where Nothing represents non-BlockId jump destinations. Fixes #24507 - - - - - 8d67f247 by Ben Gamari at 2024-03-23T16:19:09-04:00 docs: Drop old release notes, add for 9.12.1 - - - - - 7db8c992 by Cheng Shao at 2024-03-25T13:45:46-04:00 rts: fix clang compilation on aarch64 This patch fixes function prototypes in ARMOutlineAtomicsSymbols.h which causes "error: address argument to atomic operation must be a pointer to _Atomic type" when compiling with clang on aarch64. - - - - - 237194ce by Sylvain Henry at 2024-03-25T13:46:27-04:00 Lexer: fix imports for Alex 3.5.1 (#24583) - - - - - 810660b7 by Cheng Shao at 2024-03-25T22:19:16-04:00 libffi-tarballs: bump libffi-tarballs submodule to libffi 3.4.6 This commit bumps the libffi-tarballs submodule to libffi 3.4.6, which includes numerous upstream libffi fixes, especially https://github.com/libffi/libffi/issues/760. - - - - - d2ba41e8 by Alan Zimmerman at 2024-03-25T22:19:51-04:00 EPA: do not duplicate comments in signature RHS - - - - - 32a8103f by Rodrigo Mesquita at 2024-03-26T21:16:12-04:00 configure: Use LDFLAGS when trying linkers A user may configure `LDFLAGS` but not `LD`. When choosing a linker, we will prefer `ldd`, then `ld.gold`, then `ld.bfd` -- however, we have to check for a working linker. If either of these fail, we try the next in line. However, we were not considering the `$LDFLAGS` when checking if these linkers worked. So we would pick a linker that does not support the current $LDFLAGS and fail further down the line when we used that linker with those flags. Fixes #24565, where `LDFLAGS=-Wl,-z,pack-relative-relocs` is not supported by `ld.gold` but that was being picked still. - - - - - bf65a7c3 by Rodrigo Mesquita at 2024-03-26T21:16:48-04:00 bindist: Clean xattrs of bin and lib at configure time For issue #21506, we started cleaning the extended attributes of binaries and libraries from the bindist *after* they were installed to workaround notarisation (#17418), as part of `make install`. However, the `ghc-toolchain` binary that is now shipped with the bindist must be run at `./configure` time. Since we only cleaned the xattributes of the binaries and libs after they were installed, in some situations users would be unable to run `ghc-toolchain` from the bindist, failing at configure time (#24554). In this commit we move the xattr cleaning logic to the configure script. Fixes #24554 - - - - - cfeb70d3 by Rodrigo Mesquita at 2024-03-26T21:17:24-04:00 Revert "NCG: Fix a bug in jump shortcutting." This reverts commit 5bd8ed53dcefe10b72acb5729789e19ceb22df66. Fixes #24586 - - - - - 13223f6d by Serge S. Gulin at 2024-03-27T07:28:51-04:00 JS: `h$rts_isProfiled` is removed from `profiling` and left its version at `rts/js/config.js` - - - - - 0acfe391 by Alan Zimmerman at 2024-03-27T07:29:27-04:00 EPA: Do not extend declaration range for trailine zero len semi The lexer inserts virtual semicolons having zero width. Do not use them to extend the list span of items in a list. - - - - - cd0fb82f by Alan Zimmerman at 2024-03-27T19:33:08+00:00 EPA: Fix FamDecl range The span was incorrect if opt_datafam_kind_sig was empty - - - - - f8f384a8 by Ben Gamari at 2024-03-29T01:23:03-04:00 Fix type of _get_osfhandle foreign import Fixes #24601. - - - - - 00d3ecf0 by Alan Zimmerman at 2024-03-29T12:19:10+00:00 EPA: Extend StringLiteral range to include trailing commas This goes slightly against the exact printing philosophy where trailing decorations should be in an annotation, but the practicalities of adding it to the WarningTxt environment, and the problems caused by deviating do not make a more principles approach worthwhile. - - - - - efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - 912f2374 by Brandon Chinn at 2024-04-01T19:41:21-07:00 Add MultilineStrings extension - - - - - ef2f26fa by Brandon Chinn at 2024-04-01T19:41:21-07:00 Add test cases for MultilineStrings - - - - - ea19627a by Brandon Chinn at 2024-04-01T19:41:21-07:00 Break out common lex_magic_hash logic for strings and chars - - - - - 49a6f25e by Brandon Chinn at 2024-04-01T19:41:21-07:00 Factor out string processing functions - - - - - e5add677 by Brandon Chinn at 2024-04-01T19:41:21-07:00 Implement MultilineStrings (#24390) Updates haddock submodule for new ITmultiline constructor - - - - - 3aa8bea0 by Brandon Chinn at 2024-04-01T19:42:16-07:00 Add docs for MultilineStrings - - - - - 30 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/recompress-all - .gitlab/rel_eng/upload.sh - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Core/LateCC/OverloadedCalls.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Word64Map/Strict.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/775254fb84509381e042bba0d03d3b88139e6eed...3aa8bea0e1da042d78522ca9ebd738cfa3226131 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/775254fb84509381e042bba0d03d3b88139e6eed...3aa8bea0e1da042d78522ca9ebd738cfa3226131 You're receiving 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 Apr 2 07:39:09 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 03:39:09 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/seek-bin-off-by-one Message-ID: <660bb61d8c02f_1d9a9f7c1f6425966@gitlab.mail> Hannes Siebenhandl pushed new branch wip/seek-bin-off-by-one at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/seek-bin-off-by-one You're receiving 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 Apr 2 07:55:14 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 03:55:14 -0400 Subject: [Git][ghc/ghc][wip/seek-bin-off-by-one] 2 commits: Fix off by one error in seekBinNoExpand and seekBin Message-ID: <660bb9e268077_1d9a9f97d2b832086@gitlab.mail> Hannes Siebenhandl pushed to branch wip/seek-bin-off-by-one at Glasgow Haskell Compiler / GHC Commits: 2994fafc by Matthew Pickering at 2024-04-02T09:44:03+02:00 Fix off by one error in seekBinNoExpand and seekBin - - - - - f7d2f9e1 by Fendor at 2024-04-02T09:45:39+02:00 Remove `seekBin` function Binary utility `seekBin` used to expand the buffer of the `BinMem` handle. This is dubious, because the only way to call `seekBin` requires us use `tellBin`, which always gives us a pointer to already allocated index. As we don't have a way to reduce the buffer size of the underlying `BinArray`, there is no way to create an out-of-bounds pointer for the same `BinArray`. Thus, it is effectively a bug, if anyone manages to seek to an out-of-bounds location. We make this more clear by removing `seekBin` and replacing all occurrences with `seekBinNoExpand`. - - - - - 5 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Utils/Binary.hs Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -135,7 +135,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpand bh extFields_p extFields <- get bh return mod_iface @@ -191,7 +191,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do extFields_p <- tellBin bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinNoExpand bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -113,7 +113,7 @@ writeHieFile hie_file_path hiefile = do -- write the symtab pointer at the front of the file symtab_p <- tellBin bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinNoExpand bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next @@ -123,7 +123,7 @@ writeHieFile hie_file_path hiefile = do -- write the dictionary pointer at the front of the file dict_p <- tellBin bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinNoExpand bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -232,17 +232,17 @@ readHieFileContents bh0 name_cache = do get_dictionary bin_handle = do dict_p <- get bin_handle data_p <- tellBin bin_handle - seekBin bin_handle dict_p + seekBinNoExpand bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpand bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 data_p' <- tellBin bh1 - seekBin bh1 symtab_p + seekBinNoExpand bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpand bh1 data_p' return symtab putFastString :: HieDictionary -> BinHandle -> FastString -> IO () ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -42,7 +42,7 @@ instance Binary ExtensibleFields where forM_ header_entries $ \(field_p_p, dat) -> do field_p <- tellBin bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinNoExpand bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpand bh field_p dat <- get bh return (name, dat) ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -392,7 +392,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpand bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -28,9 +28,9 @@ module GHC.Utils.Binary unsafeUnpackBinBuffer, openBinMem, + seekBinNoExpand, -- closeBin, - seekBin, tellBin, castBin, withBinBuffer, @@ -222,10 +222,10 @@ class Binary a where put bh a = do p <- tellBin bh; put_ bh a; return p putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt bh p x = do seekBinNoExpand bh p; put_ bh x; return () getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt bh p = do seekBinNoExpand bh p; get bh openBinMem :: Int -> IO BinHandle openBinMem size @@ -240,18 +240,14 @@ openBinMem size tellBin :: BinHandle -> IO (Bin a) tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do - sz <- readFastMutInt sz_r - if (p >= sz) - then do expandBin h p; writeFastMutInt ix_r p - else writeFastMutInt ix_r p - --- | SeekBin but without calling expandBin +-- | 'seekBinNoExpand' moves the index pointer to the location pointed to +-- by 'Bin a'. +-- This operation may 'panic', if the pointer location is out of bounds of the +-- buffer of 'BinHandle'. seekBinNoExpand :: BinHandle -> Bin a -> IO () seekBinNoExpand (BinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r - if (p >= sz) + if (p > sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p @@ -1025,7 +1021,7 @@ lazyPut bh a = do put_ bh a -- dump the object q <- tellBin bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinNoExpand bh q -- finally carry on writing at q lazyGet :: Binary a => BinHandle -> IO a lazyGet bh = do @@ -1036,7 +1032,7 @@ lazyGet bh = do -- safety. off_r <- newFastMutInt 0 getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + seekBinNoExpand bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/11409d511801e3dfb8edeaeffb9e11ce7ef36181...f7d2f9e18e9705cd8e44c903f0129c5d1567d081 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/11409d511801e3dfb8edeaeffb9e11ce7ef36181...f7d2f9e18e9705cd8e44c903f0129c5d1567d081 You're receiving 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 Apr 2 07:57:15 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 03:57:15 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/remove-seek-bin Message-ID: <660bba5b70d5b_1d9a9f9cb8143223a@gitlab.mail> Hannes Siebenhandl pushed new branch wip/remove-seek-bin at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/remove-seek-bin You're receiving 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 Apr 2 07:57:29 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 03:57:29 -0400 Subject: [Git][ghc/ghc][wip/seek-bin-off-by-one] Deleted 1 commit: Remove `seekBin` function Message-ID: <660bba6987d96_1d9a9fa03f0c324d6@gitlab.mail> Hannes Siebenhandl pushed to branch wip/seek-bin-off-by-one at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: f7d2f9e1 by Fendor at 2024-04-02T09:45:39+02:00 Remove `seekBin` function Binary utility `seekBin` used to expand the buffer of the `BinMem` handle. This is dubious, because the only way to call `seekBin` requires us use `tellBin`, which always gives us a pointer to already allocated index. As we don't have a way to reduce the buffer size of the underlying `BinArray`, there is no way to create an out-of-bounds pointer for the same `BinArray`. Thus, it is effectively a bug, if anyone manages to seek to an out-of-bounds location. We make this more clear by removing `seekBin` and replacing all occurrences with `seekBinNoExpand`. - - - - - 5 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Utils/Binary.hs Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -135,7 +135,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpand bh extFields_p extFields <- get bh return mod_iface @@ -191,7 +191,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do extFields_p <- tellBin bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinNoExpand bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -113,7 +113,7 @@ writeHieFile hie_file_path hiefile = do -- write the symtab pointer at the front of the file symtab_p <- tellBin bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinNoExpand bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next @@ -123,7 +123,7 @@ writeHieFile hie_file_path hiefile = do -- write the dictionary pointer at the front of the file dict_p <- tellBin bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinNoExpand bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -232,17 +232,17 @@ readHieFileContents bh0 name_cache = do get_dictionary bin_handle = do dict_p <- get bin_handle data_p <- tellBin bin_handle - seekBin bin_handle dict_p + seekBinNoExpand bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpand bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 data_p' <- tellBin bh1 - seekBin bh1 symtab_p + seekBinNoExpand bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpand bh1 data_p' return symtab putFastString :: HieDictionary -> BinHandle -> FastString -> IO () ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -42,7 +42,7 @@ instance Binary ExtensibleFields where forM_ header_entries $ \(field_p_p, dat) -> do field_p <- tellBin bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinNoExpand bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpand bh field_p dat <- get bh return (name, dat) ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -392,7 +392,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpand bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -28,9 +28,9 @@ module GHC.Utils.Binary unsafeUnpackBinBuffer, openBinMem, + seekBinNoExpand, -- closeBin, - seekBin, tellBin, castBin, withBinBuffer, @@ -222,10 +222,10 @@ class Binary a where put bh a = do p <- tellBin bh; put_ bh a; return p putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt bh p x = do seekBinNoExpand bh p; put_ bh x; return () getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt bh p = do seekBinNoExpand bh p; get bh openBinMem :: Int -> IO BinHandle openBinMem size @@ -240,13 +240,6 @@ openBinMem size tellBin :: BinHandle -> IO (Bin a) tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do - sz <- readFastMutInt sz_r - if (p > sz) - then do expandBin h p; writeFastMutInt ix_r p - else writeFastMutInt ix_r p - -- | 'seekBinNoExpand' moves the index pointer to the location pointed to -- by 'Bin a'. -- This operation may 'panic', if the pointer location is out of bounds of the @@ -1028,7 +1021,7 @@ lazyPut bh a = do put_ bh a -- dump the object q <- tellBin bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinNoExpand bh q -- finally carry on writing at q lazyGet :: Binary a => BinHandle -> IO a lazyGet bh = do @@ -1039,7 +1032,7 @@ lazyGet bh = do -- safety. off_r <- newFastMutInt 0 getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + seekBinNoExpand bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7d2f9e18e9705cd8e44c903f0129c5d1567d081 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7d2f9e18e9705cd8e44c903f0129c5d1567d081 You're receiving 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 Apr 2 08:13:33 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 04:13:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/nounpack-z-encs-faststring Message-ID: <660bbe2d2cf59_1d9a9fc4f33836683@gitlab.mail> Hannes Siebenhandl pushed new branch wip/nounpack-z-encs-faststring at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/nounpack-z-encs-faststring You're receiving 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 Apr 2 10:32:31 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 06:32:31 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fendor/ghc-iface-refact Message-ID: <660bdebf32348_26e1f632434458638@gitlab.mail> Hannes Siebenhandl pushed new branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/ghc-iface-refact You're receiving 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 Apr 2 10:40:52 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 06:40:52 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] 2 commits: Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` Message-ID: <660be0b47d32a_26e1f63daedc5886b@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: 46254161 by Fendor at 2024-04-02T12:39:30+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 345e81f4 by Fendor at 2024-04-02T12:40:31+02:00 Fixup: Generic Symbol Table - - - - - 10 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -75,7 +75,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -137,7 +137,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -148,7 +148,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -156,7 +156,7 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do let -- The order of these entries matters! @@ -194,14 +194,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -211,7 +211,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -235,7 +235,7 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int, Int, b) +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) putWithTables bh' put_payload = do let -- The order of these entries matters! @@ -380,7 +380,7 @@ initWriteNameTable = do ) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -389,7 +389,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -410,7 +410,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -434,7 +434,7 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: BinSymbolTable -> BinHandle -> Name -> IO () +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } @@ -460,7 +460,7 @@ putName BinSymbolTable{ -- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name - -> BinHandle -> IO Name + -> ReadBinHandle -> IO Name getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -111,19 +111,19 @@ writeHieFile hie_file_path hiefile = do put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next symtab_map' <- readIORef symtab_map putSymbolTable bh symtab_next' symtab_map' - -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + -- write the tellBinWriter pointer at the front of the file + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -181,7 +181,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -190,7 +190,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -213,7 +213,7 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data @@ -232,21 +232,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -260,13 +260,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -276,12 +276,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable Name -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -334,7 +334,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -345,7 +345,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -37,7 +37,7 @@ computeFingerprint a = do -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -119,10 +119,10 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = case findUserDataWriter Proxy bh of tbl -> @@ -2445,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -90,10 +90,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq -import Data.Proxy +import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -322,7 +322,7 @@ putObject bh mod_name deps os = do -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -330,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -345,7 +345,7 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) @@ -353,7 +353,7 @@ getObjectBody bh0 mod_name = do block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -364,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -393,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -409,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -779,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -31,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -88,6 +90,12 @@ module GHC.Utils.Binary putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, + -- * Generic Symbol that can be used for user-defined deduplication tables. + GenericSymbolTable(..), + initGenericSymbolTable, + putGenericSymbolTable, getGenericSymbolTable, + putGenericSymTab, getGenericSymtab, + -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..) ) where @@ -171,70 +179,83 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noReaderUserData noWriterUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_reader :: ReaderUserData, -- sigh, need parameterized modules :-) - bh_writer :: WriterUserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: !WriterUserData, + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) + } + +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: !ReaderUserData, + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getReaderUserData :: BinHandle -> ReaderUserData -getReaderUserData bh = bh_reader bh +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh -getWriterUserData :: BinHandle -> WriterUserData -getWriterUserData bh = bh_writer bh +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setWriterUserData :: BinHandle -> WriterUserData -> BinHandle -setWriterUserData bh us = bh { bh_writer = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } -setReaderUserData :: BinHandle -> ReaderUserData -> BinHandle -setReaderUserData bh us = bh { bh_reader = us } +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } -addReaderToUserData :: SomeBinaryReader -> BinHandle -> BinHandle +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh - { bh_reader = (bh_reader bh) - { ud_reader_data = Map.insert typRep cache (ud_reader_data (bh_reader bh)) + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) } } -addWriterToUserData :: SomeBinaryWriter -> BinHandle -> BinHandle +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh - { bh_writer = (bh_writer bh) - { ud_writer_data = Map.insert typRep cache (ud_writer_data (bh_writer bh)) + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) } } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -253,23 +274,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -277,42 +298,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) + +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -321,20 +357,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -355,7 +394,7 @@ expandBin (BinMem _ _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -371,7 +410,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -392,8 +431,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -414,39 +453,37 @@ putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -454,7 +491,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -467,7 +504,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -479,7 +516,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -500,10 +537,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -526,15 +563,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -551,15 +588,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -575,15 +612,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -603,15 +640,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -1022,63 +1059,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1086,14 +1123,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1183,31 +1220,31 @@ mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReade mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb data BinaryReader s = BinaryReader - { getEntry :: BinHandle -> IO s + { getEntry :: ReadBinHandle -> IO s } data BinaryWriter s = BinaryWriter - { putEntry :: BinHandle -> s -> IO () + { putEntry :: WriteBinHandle -> s -> IO () } -mkWriter :: (BinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s mkWriter f = BinaryWriter { putEntry = f } -mkReader :: (BinHandle -> IO s) -> BinaryReader s +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s mkReader f = BinaryReader { getEntry = f } -findUserDataReader :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryReader a +findUserDataReader :: forall a . Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a findUserDataReader query bh = case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of Nothing -> panic $ "Failed to find BinaryReader for key " ++ show (typeRep query) Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader -findUserDataWriter :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryWriter a +findUserDataWriter :: forall a . Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a findUserDataWriter query bh = case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of Nothing -> panic $ "Failed to find BinaryWriter for key " ++ show (typeRep query) @@ -1224,8 +1261,8 @@ noWriterUserData = WriterUserData { ud_writer_data = Map.empty } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) -> ReaderUserData newReadState get_name get_fs = mkReaderUserData @@ -1233,9 +1270,9 @@ newReadState get_name get_fs = , mkSomeBinaryReader $ mkReader get_fs ] -newWriteState :: (BinHandle -> Name -> IO ()) +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) + -> (WriteBinHandle -> FastString -> IO ()) -> WriterUserData newWriteState put_binding_name put_fs = mkWriterUserData @@ -1254,14 +1291,80 @@ data SomeWriterTable f = forall a . Typeable a => SomeWriterTable (f (WriterTable, BinaryWriter a)) data ReaderTable a = ReaderTable - { getTable :: BinHandle -> IO (SymbolTable a) + { getTable :: ReadBinHandle -> IO (SymbolTable a) , mkReaderFromTable :: SymbolTable a -> BinaryReader a } data WriterTable = WriterTable - { putTable :: BinHandle -> IO Int + { putTable :: WriteBinHandle -> IO Int + } + +-- ---------------------------------------------------------------------------- +-- Common data structures for constructing and maintaining lookup tables for +-- binary serialisation and deserialisation. +-- ---------------------------------------------------------------------------- + +data GenericSymbolTable a = GenericSymbolTable + { gen_symtab_next :: !FastMutInt + -- ^ The next index to use + , gen_symtab_map :: !(IORef (Map.Map a Int)) + -- ^ Given a symbol, find the symbol } +initGenericSymbolTable :: IO (GenericSymbolTable a) +initGenericSymbolTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef Map.empty + pure $ GenericSymbolTable + { gen_symtab_next = symtab_next + , gen_symtab_map = symtab_map + } + +putGenericSymbolTable :: forall a. GenericSymbolTable a -> (WriteBinHandle -> a -> IO ()) -> WriteBinHandle -> IO Int +putGenericSymbolTable gen_sym_tab serialiser bh = do + table_count <- readFastMutInt symtab_next + symtab_map <- readIORef symtab_map + putGenericSymbolTable bh table_count symtab_map + pure table_count + where + symtab_map = gen_symtab_map gen_sym_tab + symtab_next = gen_symtab_next gen_sym_tab + putGenericSymbolTable :: WriteBinHandle -> Int -> Map.Map a Int -> IO () + putGenericSymbolTable bh name_count symtab = do + put_ bh name_count + let genElements = elems (array (0,name_count-1) (fmap swap $ Map.toList symtab)) + mapM_ (\n -> serialiser bh n) genElements + +getGenericSymbolTable :: forall a. (ReadBinHandle -> IO a) -> ReadBinHandle -> IO (SymbolTable a) +getGenericSymbolTable deserialiser bh = do + sz <- get bh :: IO Int + mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int a) + forM_ [0..(sz-1)] $ \i -> do + f <- deserialiser bh + writeArray mut_arr i f + unsafeFreeze mut_arr + +putGenericSymTab :: (Ord a, Binary a) => GenericSymbolTable a -> WriteBinHandle -> a -> IO () +putGenericSymTab GenericSymbolTable{ + gen_symtab_map = symtab_map_ref, + gen_symtab_next = symtab_next } + bh val = do + symtab_map <- readIORef symtab_map_ref + case Map.lookup val symtab_map of + Just off -> put_ bh (fromIntegral off :: Word32) + Nothing -> do + off <- readFastMutInt symtab_next + writeFastMutInt symtab_next (off+1) + writeIORef symtab_map_ref + $! Map.insert val off symtab_map + put_ bh (fromIntegral off :: Word32) + +getGenericSymtab :: Binary a => SymbolTable a + -> ReadBinHandle -> IO a +getGenericSymtab symtab bh = do + i :: Word32 <- get bh + return $! symtab ! fromIntegral i + --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- @@ -1299,14 +1402,14 @@ initFastStringWriterTable = do , mkWriter $ putDictFastString bin_dict ) -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1315,12 +1418,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1357,34 +1460,34 @@ type SymbolTable a = Array Int a -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit d559cde5afeb9323861428a7317a59be055b9e13 +Subproject commit 799390d1c6d59a606c3dd00dea057baa26ed0c2f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08f11545cae90c5187fb05b71299e7a4f0e727ad...345e81f47d9f811c124207ce51cf8f95bdb01b1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08f11545cae90c5187fb05b71299e7a4f0e727ad...345e81f47d9f811c124207ce51cf8f95bdb01b1e You're receiving 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 Apr 2 10:50:30 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 06:50:30 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fendor/ghc-iface-refact-with-gen-sym-table Message-ID: <660be2f662d63_26e1f654d1c0590dd@gitlab.mail> Hannes Siebenhandl pushed new branch wip/fendor/ghc-iface-refact-with-gen-sym-table at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/ghc-iface-refact-with-gen-sym-table You're receiving 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 Apr 2 10:51:06 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 06:51:06 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] Deleted 1 commit: Fixup: Generic Symbol Table Message-ID: <660be31a9a063_26e1f659e020592c0@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: 345e81f4 by Fendor at 2024-04-02T12:40:31+02:00 Fixup: Generic Symbol Table - - - - - 1 changed file: - compiler/GHC/Utils/Binary.hs Changes: ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -89,15 +89,6 @@ module GHC.Utils.Binary initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, -<<<<<<< HEAD - -- * Generic Symbol that can be used for user-defined deduplication tables. - GenericSymbolTable(..), - initGenericSymbolTable, - putGenericSymbolTable, getGenericSymbolTable, - putGenericSymTab, getGenericSymtab, -||||||| parent of f3fd018a62 (Fixup: Generic Symbol Table) - -======= -- * Generic Symbol that can be used for user-defined deduplication tables. GenericSymbolTable(..), @@ -105,7 +96,6 @@ module GHC.Utils.Binary putGenericSymbolTable, getGenericSymbolTable, putGenericSymTab, getGenericSymtab, ->>>>>>> f3fd018a62 (Fixup: Generic Symbol Table) -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..) ) where @@ -1330,7 +1320,7 @@ initGenericSymbolTable = do , gen_symtab_map = symtab_map } -putGenericSymbolTable :: forall a. GenericSymbolTable a -> (BinHandle -> a -> IO ()) -> BinHandle -> IO Int +putGenericSymbolTable :: forall a. GenericSymbolTable a -> (WriteBinHandle -> a -> IO ()) -> WriteBinHandle -> IO Int putGenericSymbolTable gen_sym_tab serialiser bh = do table_count <- readFastMutInt symtab_next symtab_map <- readIORef symtab_map @@ -1339,13 +1329,13 @@ putGenericSymbolTable gen_sym_tab serialiser bh = do where symtab_map = gen_symtab_map gen_sym_tab symtab_next = gen_symtab_next gen_sym_tab - putGenericSymbolTable :: BinHandle -> Int -> Map.Map a Int -> IO () + putGenericSymbolTable :: WriteBinHandle -> Int -> Map.Map a Int -> IO () putGenericSymbolTable bh name_count symtab = do put_ bh name_count let genElements = elems (array (0,name_count-1) (fmap swap $ Map.toList symtab)) mapM_ (\n -> serialiser bh n) genElements -getGenericSymbolTable :: forall a. (BinHandle -> IO a) -> BinHandle -> IO (SymbolTable a) +getGenericSymbolTable :: forall a. (ReadBinHandle -> IO a) -> ReadBinHandle -> IO (SymbolTable a) getGenericSymbolTable deserialiser bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int a) @@ -1354,7 +1344,7 @@ getGenericSymbolTable deserialiser bh = do writeArray mut_arr i f unsafeFreeze mut_arr -putGenericSymTab :: (Ord a, Binary a) => GenericSymbolTable a -> BinHandle -> a -> IO () +putGenericSymTab :: (Ord a, Binary a) => GenericSymbolTable a -> WriteBinHandle -> a -> IO () putGenericSymTab GenericSymbolTable{ gen_symtab_map = symtab_map_ref, gen_symtab_next = symtab_next } @@ -1370,7 +1360,7 @@ putGenericSymTab GenericSymbolTable{ put_ bh (fromIntegral off :: Word32) getGenericSymtab :: Binary a => SymbolTable a - -> BinHandle -> IO a + -> ReadBinHandle -> IO a getGenericSymtab symtab bh = do i :: Word32 <- get bh return $! symtab ! fromIntegral i View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/345e81f47d9f811c124207ce51cf8f95bdb01b1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/345e81f47d9f811c124207ce51cf8f95bdb01b1e You're receiving 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 Apr 2 10:56:14 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 06:56:14 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] 2 commits: Refactor the Binary serialisation interface Message-ID: <660be44ee24c_26e1f6733da463048@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: df5c3fc0 by Fendor at 2024-04-02T12:55:43+02:00 Refactor the Binary serialisation interface The end goal is to dynamically add deduplication tables for `ModIface` interface serialisation. We identify two main points of interest that make this difficult: 1. UserData hardcodes what `Binary` instances can have deduplication tables. Moreover, it heavily uses partial functions. 2. GHC.Iface.Binary hardcodes the deduplication tables for 'Name' and 'FastString', making it difficult to add more deduplication. Instead of having a single `UserData` record with fields for all the types that can have deduplication tables, we allow to provide custom serialisers for any `Typeable`. These are wrapped in existentials and stored in a `Map` indexed by their respective `TypeRep`. The `Binary` instance of the type to deduplicate still needs to explicitly look up the decoder via `findUserDataReader` and `findUserDataWriter`, which is no worse than the status-quo. `Map` was chosen as microbenchmarks indicate it is the fastest for a small number of keys (< 10). To generalise the deduplication table serialisation mechanism, we introduce the types `ReaderTable` and `WriterTable` which provide a simple interface that is sufficient to implement a general purpose deduplication mechanism for `writeBinIface` and `readBinIface`. This allows us to provide a list of deduplication tables for serialisation that can be extended more easily, for example for `IfaceTyCon`, see the issue https://gitlab.haskell.org/ghc/ghc/-/issues/24540 for more motivation. In addition to ths refactoring, we split `UserData` into `ReaderUserData` and `WriterUserData`, to avoid partial functions. Bump haddock submodule to accomodate for `UserData` split. - - - - - aa3ccba8 by Fendor at 2024-04-02T12:55:43+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 15 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -29,7 +29,6 @@ module GHC.Iface.Binary ( import GHC.Prelude -import GHC.Tc.Utils.Monad import GHC.Builtin.Utils ( isKnownKeyName, lookupKnownKeyName ) import GHC.Unit import GHC.Unit.Module.ModIface @@ -54,6 +53,7 @@ import Data.Char import Data.Word import Data.IORef import Control.Monad +import Data.Functor.Identity -- --------------------------------------------------------------------------- -- Reading and writing binary interface files @@ -75,7 +75,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -121,6 +121,8 @@ readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do pure (src_hash, bh) -- | Read an interface file. +-- +-- See Note [Iface Binary Serialisation] for details. readBinIface :: Profile -> NameCache @@ -135,7 +137,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -146,7 +148,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -154,24 +156,32 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do - -- Read the dictionary - -- The next word in the file is a pointer to where the dictionary is - -- (probably at the end of the file) - dict <- Binary.forwardGet bh (getDictionary bh) - - -- Initialise the user-data field of bh - let bh_fs = setUserData bh $ newReadState (error "getSymtabName") - (getDictFastString dict) - - symtab <- Binary.forwardGet bh_fs (getSymbolTable bh_fs name_cache) - - -- It is only now that we know how to get a Name - return $ setUserData bh $ newReadState (getSymtabName name_cache dict symtab) - (getDictFastString dict) - --- | Write an interface file + let + -- The order of these entries matters! + -- + -- See Note [Iface Binary Serialiser Order] for details. + tables :: [SomeReaderTable IO] + tables = + [ SomeReaderTable initFastStringReaderTable + , SomeReaderTable (initReadNameCachedBinary name_cache) + ] + + tables <- traverse (\(SomeReaderTable tblM) -> tblM >>= pure . SomeReaderTable . pure) tables + + final_bh <- foldM (\bh (SomeReaderTable (tbl' :: Identity (ReaderTable a))) -> do + let tbl = runIdentity tbl' + res <- Binary.forwardGet bh (getTable tbl bh) + let newDecoder = mkReaderFromTable tbl res + pure $ addReaderToUserData (mkSomeBinaryReader newDecoder) bh + ) bh tables + + pure final_bh + +-- | Write an interface file. +-- +-- See Note [Iface Binary Serialisation] for details. writeBinIface :: Profile -> TraceBinIFace -> FilePath -> ModIface -> IO () writeBinIface profile traceBinIface hi_path mod_iface = do bh <- openBinMem initBinMemSize @@ -184,14 +194,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -201,7 +211,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -225,43 +235,39 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int,Int,b) -putWithTables bh put_payload = do - -- initialize state for the name table and the FastString table. - symtab_next <- newFastMutInt 0 - symtab_map <- newIORef emptyUFM - let bin_symtab = BinSymbolTable - { bin_symtab_next = symtab_next - , bin_symtab_map = symtab_map - } - - (bh_fs, bin_dict, put_dict) <- initFSTable bh - - (fs_count,(name_count,r)) <- forwardPut bh (const put_dict) $ do - - -- NB. write the dictionary after the symbol table, because - -- writing the symbol table may create more dictionary entries. - let put_symtab = do - name_count <- readFastMutInt symtab_next - symtab_map <- readIORef symtab_map - putSymbolTable bh_fs name_count symtab_map - pure name_count - - forwardPut bh_fs (const put_symtab) $ do - - -- BinHandle with FastString and Name writing support - let ud_fs = getUserData bh_fs - let ud_name = ud_fs - { ud_put_nonbinding_name = putName bin_dict bin_symtab - , ud_put_binding_name = putName bin_dict bin_symtab - } - let bh_name = setUserData bh ud_name - - put_payload bh_name - - return (name_count, fs_count, r) - - +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) +putWithTables bh' put_payload = do + let + -- The order of these entries matters! + -- + -- See Note [Iface Binary Serialiser Order] for details. + writerTables = + [ SomeWriterTable initFastStringWriterTable + , SomeWriterTable initWriteNameTable + ] + + tables <- traverse (\(SomeWriterTable worker) -> worker >>= pure . SomeWriterTable . pure) writerTables + + let writerUserData = + mkWriterUserData $ + map + (\(SomeWriterTable tbl') -> mkSomeBinaryWriter (snd $ runIdentity tbl')) + tables + + let bh = setWriterUserData bh' writerUserData + (fs_count : name_count : _, r) <- + putAllTables bh (fmap (\(SomeWriterTable tbl) -> fst $ runIdentity tbl) tables) $ do + put_payload bh + + return (name_count, fs_count, r) + where + putAllTables _ [] act = do + a <- act + pure ([], a) + putAllTables bh (x : xs) act = do + (r, (res, a)) <- forwardPut bh (const $ putTable x bh) $ do + putAllTables bh xs act + pure (r : res, a) -- | Initial ram buffer to allocate for writing interface files initBinMemSize :: Int @@ -273,11 +279,108 @@ binaryInterfaceMagic platform | otherwise = FixedLengthEncoding 0x1face64 +{- +Note [Iface Binary Serialisation] +~~~~~~~~~~~~~~~~~~~ +When we serialise a 'ModIface', many symbols are redundant. +For example, there can be duplicated 'FastString's and 'Name's. +To save space, we deduplicate some symbols, such as 'FastString' and 'Name', +by maintaining a table of already seen symbols. +When serialising a symbol, we lookup whether we have encountered the symbol before. +If yes, we write the index of the symbol, otherwise we generate a new index and store it in the table. + +Besides saving a lot of disk space, this additionally enables us to automatically share +these symbols when we read the 'ModIface' from disk, without additional mechanisms such as 'FastStringTable'. + +Note [Iface Binary Serialiser Order] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Serialisation of 'ModIface' uses tables to deduplicate symbols that occur often. + +After 'ModIface' has been written to disk, we write the deduplication tables. +Writing a table may add additional entries to *other* deduplication tables, thus +we need to make sure that the symbol table we serialise only depends on +deduplication tables that haven't been written to disk yet. + +For example, assume we maintain deduplication tables for 'FastString' and 'Name'. +The symbol 'Name' depends on 'FastString', so serialising a 'Name' may add a 'FastString' +to the 'FastString' deduplication table. +Thus, 'Name' table needs to be serialised to disk before the 'FastString' table. + +When we read the 'ModIface' from disk, we consequentially need to read the 'FastString' +deduplication table from disk, before we can deserialise the 'Name' deduplication table. +Therefore, before we serialise the tables, we write forward pointers that allow us to jump ahead +to the table we need to deserialise first. + +Here, a visualisation of the table structure we currently have: + +┌──────────────┐ +│ Headers │ +├──────────────┤ +│ │ +│ ModIface │ +│ Payload │ +│ │ +├──────────────┤ +│ Ptr FS ├───────────┐ +├──────────────┤ │ +│ Ptr Name ├────────┐ │ +├──────────────┤ │ │ +│ │ │ │ +│ Name Table │◄───────┘ │ +│ │ │ +├──────────────┤ │ +│ │ │ +│ FS Table │◄──────────┘ +│ │ +└──────────────┘ + +-} + + -- ----------------------------------------------------------------------------- -- The symbol table -- -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () + +initReadNameCachedBinary :: NameCache -> IO (ReaderTable Name) +initReadNameCachedBinary cache = do + return $ + ReaderTable + { getTable = \bh -> getSymbolTable bh cache + , mkReaderFromTable = \tbl -> mkReader (getSymtabName tbl) + } + +data BinSymbolTable = BinSymbolTable { + bin_symtab_next :: !FastMutInt, -- The next index to use + bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) + -- indexed by Name + } + +initWriteNameTable :: IO (WriterTable, BinaryWriter Name) +initWriteNameTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef emptyUFM + let bin_symtab = + BinSymbolTable + { bin_symtab_next = symtab_next + , bin_symtab_map = symtab_map + } + + let put_symtab bh = do + name_count <- readFastMutInt symtab_next + symtab_map <- readIORef symtab_map + putSymbolTable bh name_count symtab_map + pure name_count + + return + ( WriterTable + { putTable = put_symtab + } + , mkWriter $ putName bin_symtab + ) + + +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -286,7 +389,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -307,7 +410,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -331,8 +434,8 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: FSTable -> BinSymbolTable -> BinHandle -> Name -> IO () -putName _dict BinSymbolTable{ +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () +putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } bh name @@ -356,10 +459,9 @@ putName _dict BinSymbolTable{ put_ bh (fromIntegral off :: Word32) -- See Note [Symbol table representation of names] -getSymtabName :: NameCache - -> Dictionary -> SymbolTable - -> BinHandle -> IO Name -getSymtabName _name_cache _dict symtab bh = do +getSymtabName :: SymbolTable Name + -> ReadBinHandle -> IO Name +getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of 0x00000000 -> return $! symtab ! fromIntegral i @@ -376,10 +478,3 @@ getSymtabName _name_cache _dict symtab bh = do Just n -> n _ -> pprPanic "getSymtabName:unknown name tag" (ppr i) - -data BinSymbolTable = BinSymbolTable { - bin_symtab_next :: !FastMutInt, -- The next index to use - bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) - -- indexed by Name - } - ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -105,25 +105,25 @@ writeHieFile hie_file_path hiefile = do hie_dict_map = dict_map_ref } -- put the main thing - let bh = setUserData bh0 $ newWriteState (putName hie_symtab) - (putName hie_symtab) - (putFastString hie_dict) + let bh = setWriterUserData bh0 + $ newWriteState (putName hie_symtab) + (putFastString hie_dict) put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next symtab_map' <- readIORef symtab_map putSymbolTable bh symtab_next' symtab_map' - -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + -- write the tellBinWriter pointer at the front of the file + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -181,7 +181,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -190,7 +190,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -213,15 +213,16 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data bh1 <- do - let bh1 = setUserData bh0 $ newReadState (error "getSymtabName") - (getDictFastString dict) + let bh1 = setReaderUserData bh0 + $ newReadState (error "getSymtabName") + (getDictFastString dict) symtab <- get_symbol_table bh1 - let bh1' = setUserData bh1 + let bh1' = setReaderUserData bh1 $ newReadState (getSymTabName symtab) (getDictFastString dict) return bh1' @@ -231,21 +232,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -259,13 +260,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -275,12 +276,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -333,7 +334,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -344,7 +345,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -520,7 +520,7 @@ checkFlagHash :: HscEnv -> ModIface -> IO RecompileRequired checkFlagHash hsc_env iface = do let logger = hsc_logger hsc_env let old_hash = mi_flag_hash (mi_final_exts iface) - new_hash <- fingerprintDynFlags hsc_env (mi_module iface) putNameLiterally + new_hash <- fingerprintDynFlags hsc_env (mi_module iface) case old_hash == new_hash of True -> up_to_date logger (text "Module flags unchanged") False -> out_of_date_hash logger FlagsChanged @@ -533,7 +533,6 @@ checkOptimHash hsc_env iface = do let logger = hsc_logger hsc_env let old_hash = mi_opt_hash (mi_final_exts iface) new_hash <- fingerprintOptFlags (hsc_dflags hsc_env) - putNameLiterally if | old_hash == new_hash -> up_to_date logger (text "Optimisation flags unchanged") | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env) @@ -549,7 +548,6 @@ checkHpcHash hsc_env iface = do let logger = hsc_logger hsc_env let old_hash = mi_hpc_hash (mi_final_exts iface) new_hash <- fingerprintHpcFlags (hsc_dflags hsc_env) - putNameLiterally if | old_hash == new_hash -> up_to_date logger (text "HPC flags unchanged") | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env) @@ -960,7 +958,6 @@ addFingerprints -> IO ModIface addFingerprints hsc_env iface0 = do - eps <- hscEPS hsc_env let decls = mi_decls iface0 decl_warn_fn = mkIfaceDeclWarnCache (fromIfaceWarnings $ mi_warns iface0) @@ -1023,40 +1020,6 @@ addFingerprints hsc_env iface0 groups :: [SCC IfaceDeclABI] groups = stronglyConnCompFromEdgedVerticesOrd edges - global_hash_fn = mkHashFun hsc_env eps - - -- How to output Names when generating the data to fingerprint. - -- Here we want to output the fingerprint for each top-level - -- Name, whether it comes from the current module or another - -- module. In this way, the fingerprint for a declaration will - -- change if the fingerprint for anything it refers to (transitively) - -- changes. - mk_put_name :: OccEnv (OccName,Fingerprint) - -> BinHandle -> Name -> IO () - mk_put_name local_env bh name - | isWiredInName name = putNameLiterally bh name - -- wired-in names don't have fingerprints - | otherwise - = assertPpr (isExternalName name) (ppr name) $ - let hash | nameModule name /= semantic_mod = global_hash_fn name - -- Get it from the REAL interface!! - -- This will trigger when we compile an hsig file - -- and we know a backing impl for it. - -- See Note [Identity versus semantic module] - | semantic_mod /= this_mod - , not (isHoleModule semantic_mod) = global_hash_fn name - | otherwise = return (snd (lookupOccEnv local_env (getOccName name) - `orElse` pprPanic "urk! lookup local fingerprint" - (ppr name $$ ppr local_env))) - -- This panic indicates that we got the dependency - -- analysis wrong, because we needed a fingerprint for - -- an entity that wasn't in the environment. To debug - -- it, turn the panic into a trace, uncomment the - -- pprTraces below, run the compile again, and inspect - -- the output and the generated .hi file with - -- --show-iface. - in hash >>= put_ bh - -- take a strongly-connected group of declarations and compute -- its fingerprint. @@ -1067,23 +1030,18 @@ addFingerprints hsc_env iface0 [(Fingerprint,IfaceDecl)]) fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi) - = do let hash_fn = mk_put_name local_env - decl = abiDecl abi + = do let decl = abiDecl abi --pprTrace "fingerprinting" (ppr (ifName decl) ) $ do - hash <- computeFingerprint hash_fn abi + hash <- computeFingerprint abi env' <- extend_hash_env local_env (hash,decl) return (env', (hash,decl) : decls_w_hashes) fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis) = do let stable_abis = sortBy cmp_abiNames abis stable_decls = map abiDecl stable_abis - local_env1 <- foldM extend_hash_env local_env - (zip (map mkRecFingerprint [0..]) stable_decls) - -- See Note [Fingerprinting recursive groups] - let hash_fn = mk_put_name local_env1 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do -- put the cycle in a canonical order - hash <- computeFingerprint hash_fn stable_abis + hash <- computeFingerprint stable_abis let pairs = zip (map (bumpFingerprint hash) [0..]) stable_decls -- See Note [Fingerprinting recursive groups] local_env2 <- foldM extend_hash_env local_env pairs @@ -1156,11 +1114,10 @@ addFingerprints hsc_env iface0 -- instances yourself, no need to consult hs-boot; if you do load the -- interface into EPS, you will see a duplicate orphan instance. - orphan_hash <- computeFingerprint (mk_put_name local_env) - (map ifDFun orph_insts, orph_rules, orph_fis) + orphan_hash <- computeFingerprint (map ifDFun orph_insts, orph_rules, orph_fis) -- Hash of the transitive things in dependencies - dep_hash <- computeFingerprint putNameLiterally + dep_hash <- computeFingerprint (dep_sig_mods (mi_deps iface0), dep_boot_mods (mi_deps iface0), -- Trusted packages are like orphans @@ -1170,7 +1127,7 @@ addFingerprints hsc_env iface0 -- the export list hash doesn't depend on the fingerprints of -- the Names it mentions, only the Names themselves, hence putNameLiterally. - export_hash <- computeFingerprint putNameLiterally + export_hash <- computeFingerprint (mi_exports iface0, orphan_hash, dep_hash, @@ -1229,11 +1186,11 @@ addFingerprints hsc_env iface0 -- - (some of) dflags -- it returns two hashes, one that shouldn't change -- the abi hash and one that should - flag_hash <- fingerprintDynFlags hsc_env this_mod putNameLiterally + flag_hash <- fingerprintDynFlags hsc_env this_mod - opt_hash <- fingerprintOptFlags dflags putNameLiterally + opt_hash <- fingerprintOptFlags dflags - hpc_hash <- fingerprintHpcFlags dflags putNameLiterally + hpc_hash <- fingerprintHpcFlags dflags plugin_hash <- fingerprintPlugins (hsc_plugins hsc_env) @@ -1243,7 +1200,7 @@ addFingerprints hsc_env iface0 -- - orphans -- - deprecations -- - flag abi hash - mod_hash <- computeFingerprint putNameLiterally + mod_hash <- computeFingerprint (map fst sorted_decls, export_hash, -- includes orphan_hash mi_warns iface0) @@ -1255,7 +1212,7 @@ addFingerprints hsc_env iface0 -- - usages -- - deps (home and external packages, dependent files) -- - hpc - iface_hash <- computeFingerprint putNameLiterally + iface_hash <- computeFingerprint (mod_hash, mi_src_hash iface0, ann_fn (mkVarOccFS (fsLit "module")), -- See mkIfaceAnnCache @@ -1594,57 +1551,6 @@ mkOrphMap get_key decls = (extendOccEnv_Acc (:) Utils.singleton non_orphs occ d, orphs) | otherwise = (non_orphs, d:orphs) --- ----------------------------------------------------------------------------- --- Look up parents and versions of Names - --- This is like a global version of the mi_hash_fn field in each ModIface. --- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get --- the parent and version info. - -mkHashFun - :: HscEnv -- needed to look up versions - -> ExternalPackageState -- ditto - -> (Name -> IO Fingerprint) -mkHashFun hsc_env eps name - | isHoleModule orig_mod - = lookup (mkHomeModule home_unit (moduleName orig_mod)) - | otherwise - = lookup orig_mod - where - home_unit = hsc_home_unit hsc_env - dflags = hsc_dflags hsc_env - hpt = hsc_HUG hsc_env - pit = eps_PIT eps - ctx = initSDocContext dflags defaultUserStyle - occ = nameOccName name - orig_mod = nameModule name - lookup mod = do - massertPpr (isExternalName name) (ppr name) - iface <- case lookupIfaceByModule hpt pit mod of - Just iface -> return iface - Nothing -> - -- This can occur when we're writing out ifaces for - -- requirements; we didn't do any /real/ typechecking - -- so there's no guarantee everything is loaded. - -- Kind of a heinous hack. - initIfaceLoad hsc_env . withIfaceErr ctx - $ withoutDynamicNow - -- If you try and load interfaces when dynamic-too - -- enabled then it attempts to load the dyn_hi and hi - -- interface files. Backpack doesn't really care about - -- dynamic object files as it isn't doing any code - -- generation so -dynamic-too is turned off. - -- Some tests fail without doing this (such as T16219), - -- but they fail because dyn_hi files are not found for - -- one of the dependencies (because they are deliberately turned off) - -- Why is this check turned off here? That is unclear but - -- just one of the many horrible hacks in the backpack - -- implementation. - $ loadInterface (text "lookupVers2") mod ImportBySystem - return $ snd (mi_hash_fn (mi_final_exts iface) occ `orElse` - pprPanic "lookupVers1" (ppr mod <+> ppr occ)) - - -- | Creates cached lookup for the 'mi_anns' field of ModIface -- Hackily, we use "module" as the OccName for any module-level annotations mkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload] ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -26,20 +26,18 @@ fingerprintBinMem bh = withBinBuffer bh f in fp `seq` return fp computeFingerprint :: (Binary a) - => (BinHandle -> Name -> IO ()) - -> a + => a -> IO Fingerprint -computeFingerprint put_nonbinding_name a = do +computeFingerprint a = do bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block put_ bh a fingerprintBinMem bh where - set_user_data bh = - setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS + set_user_data bh = setWriterUserData bh $ newWriteState putNameLiterally putFS -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -13,9 +13,7 @@ import GHC.Prelude import GHC.Driver.Session import GHC.Driver.Env -import GHC.Utils.Binary import GHC.Unit.Module -import GHC.Types.Name import GHC.Types.SafeHaskell import GHC.Utils.Fingerprint import GHC.Iface.Recomp.Binary @@ -31,10 +29,9 @@ import System.FilePath (normalise) -- NB: The 'Module' parameter is the 'Module' recorded by the *interface* -- file, not the actual 'Module' according to our 'DynFlags'. fingerprintDynFlags :: HscEnv -> Module - -> (BinHandle -> Name -> IO ()) -> IO Fingerprint -fingerprintDynFlags hsc_env this_mod nameio = +fingerprintDynFlags hsc_env this_mod = let dflags at DynFlags{..} = hsc_dflags hsc_env mainis = if mainModIs (hsc_HUE hsc_env) == this_mod then Just mainFunIs else Nothing -- see #5878 @@ -73,7 +70,7 @@ fingerprintDynFlags hsc_env this_mod nameio = flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, codegen, debugLevel, callerCcFilters)) in -- pprTrace "flags" (ppr flags) $ - computeFingerprint nameio flags + computeFingerprint flags -- Fingerprint the optimisation info. We keep this separate from the rest of -- the flags because GHCi users (especially) may wish to ignore changes in @@ -81,9 +78,8 @@ fingerprintDynFlags hsc_env this_mod nameio = -- object files as they can. -- See Note [Ignoring some flag changes] fingerprintOptFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) -> IO Fingerprint -fingerprintOptFlags DynFlags{..} nameio = +fingerprintOptFlags DynFlags{..} = let -- See https://gitlab.haskell.org/ghc/ghc/issues/10923 -- We used to fingerprint the optimisation level, but as Joachim @@ -92,22 +88,21 @@ fingerprintOptFlags DynFlags{..} nameio = opt_flags = map fromEnum $ filter (`EnumSet.member` optimisationFlags) (EnumSet.toList generalFlags) - in computeFingerprint nameio opt_flags + in computeFingerprint opt_flags -- Fingerprint the HPC info. We keep this separate from the rest of -- the flags because GHCi users (especially) may wish to use an object -- file compiled for HPC when not actually using HPC. -- See Note [Ignoring some flag changes] fingerprintHpcFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) -> IO Fingerprint -fingerprintHpcFlags dflags at DynFlags{..} nameio = +fingerprintHpcFlags dflags at DynFlags{..} = let -- -fhpc, see https://gitlab.haskell.org/ghc/ghc/issues/11798 -- hpcDir is output-only, so we should recompile if it changes hpc = if gopt Opt_Hpc dflags then Just hpcDir else Nothing - in computeFingerprint nameio hpc + in computeFingerprint hpc {- Note [path flags and recompilation] ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith, import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Proxy infixl 3 &&& @@ -118,15 +119,15 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = - case getUserData bh of - UserData{ ud_put_binding_name = put_binding_name } -> + case findUserDataWriter Proxy bh of + tbl -> --pprTrace "putIfaceTopBndr" (ppr name) $ - put_binding_name bh name + putEntry tbl bh name data IfaceDecl @@ -585,7 +586,7 @@ ifaceDeclFingerprints hash decl where computeFingerprint' = unsafeDupablePerformIO - . computeFingerprint (panic "ifaceDeclFingerprints") + . computeFingerprint fromIfaceWarnings :: IfaceWarnings -> Warnings GhcRn fromIfaceWarnings = \case @@ -2444,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -9,7 +9,6 @@ This module defines interface types and binders {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE LambdaCase #-} - module GHC.Iface.Type ( IfExtName, IfLclName, @@ -90,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ @@ -2045,11 +2044,12 @@ instance Outputable IfaceCoercion where ppr = pprIfaceCoercion instance Binary IfaceTyCon where - put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i + put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i - get bh = do n <- get bh - i <- get bh - return (IfaceTyCon n i) + get bh = do + n <- get bh + i <- get bh + return (IfaceTyCon n i) instance Binary IfaceTyConSort where put_ bh IfaceNormalTyCon = putByte bh 0 ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -66,6 +66,9 @@ import GHC.Prelude import Control.Monad import Data.Array +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import Data.Char (isSpace) import Data.Int import Data.IntSet (IntSet) import qualified Data.IntSet as IS @@ -75,10 +78,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Word import Data.Semigroup -import qualified Data.ByteString as B -import qualified Data.ByteString.Unsafe as B -import Data.Char (isSpace) -import System.IO +import System.IO import GHC.Settings.Constants (hiVersion) @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -313,15 +313,16 @@ putObject bh mod_name deps os = do -- object in an archive. put_ bh (moduleNameString mod_name) - (bh_fs, _bin_dict, put_dict) <- initFSTable bh + (fs_tbl, fs_writer) <- initFastStringWriterTable + let bh_fs = addWriterToUserData (mkSomeBinaryWriter fs_writer) bh - forwardPut_ bh (const put_dict) $ do + forwardPut_ bh (const (putTable fs_tbl bh_fs)) $ do put_ bh_fs deps -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -329,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -344,15 +345,15 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) - let bh = setUserData bh0 $ noUserData { ud_get_fs = getDictFastString dict } + let bh = setReaderUserData bh0 $ newReadState (panic "No name allowed") (getDictFastString dict) block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -363,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -392,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -408,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -778,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -1010,7 +1010,7 @@ data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple - deriving( Eq, Data ) + deriving( Eq, Data, Ord ) instance Outputable TupleSort where ppr ts = text $ ===================================== compiler/GHC/Types/FieldLabel.hs ===================================== @@ -140,9 +140,8 @@ instance Binary Name => Binary FieldLabel where put_ bh (FieldLabel aa ab ac) = do put_ bh aa put_ bh ab - case getUserData bh of - UserData{ ud_put_binding_name = put_binding_name } -> - put_binding_name bh ac + case findUserDataWriter Proxy bh of + tbl -> putEntry tbl bh ac get bh = do aa <- get bh ab <- get bh ===================================== compiler/GHC/Types/Name.hs ===================================== @@ -663,12 +663,12 @@ instance Data Name where -- distinction. instance Binary Name where put_ bh name = - case getUserData bh of - UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name + case findUserDataWriter Proxy bh of + tbl -> putEntry tbl bh name get bh = - case getUserData bh of - UserData { ud_get_name = get_name } -> get_name bh + case findUserDataReader Proxy bh of + tbl -> getEntry tbl bh {- ************************************************************************ ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -4,6 +4,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-} +{-# LANGUAGE TypeFamilies #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected @@ -21,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -30,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -66,13 +69,43 @@ module GHC.Utils.Binary lazyPutMaybe, -- * User data - UserData(..), getUserData, setUserData, - newReadState, newWriteState, noUserData, - + ReaderUserData(..), getReaderUserData, setReaderUserData, noReaderUserData, + WriterUserData(..), getWriterUserData, setWriterUserData, noWriterUserData, + mkWriterUserData, mkReaderUserData, + newReadState, newWriteState, + addReaderToUserData, addWriterToUserData, + findUserDataReader, findUserDataWriter, + -- * Binary Readers & Writers + BinaryReader(..), BinaryWriter(..), + mkWriter, mkReader, + SomeBinaryReader, SomeBinaryWriter, + mkSomeBinaryReader, mkSomeBinaryWriter, + -- * Tables + SomeReaderTable(..), + ReaderTable(..), + SomeWriterTable(..), + WriterTable(..), -- * String table ("dictionary") + initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, - FSTable, initFSTable, getDictFastString, putDictFastString, - + FSTable(..), getDictFastString, putDictFastString, +<<<<<<< HEAD + -- * Generic Symbol that can be used for user-defined deduplication tables. + GenericSymbolTable(..), + initGenericSymbolTable, + putGenericSymbolTable, getGenericSymbolTable, + putGenericSymTab, getGenericSymtab, +||||||| parent of f3fd018a62 (Fixup: Generic Symbol Table) + +======= + + -- * Generic Symbol that can be used for user-defined deduplication tables. + GenericSymbolTable(..), + initGenericSymbolTable, + putGenericSymbolTable, getGenericSymbolTable, + putGenericSymTab, getGenericSymtab, + +>>>>>>> f3fd018a62 (Fixup: Generic Symbol Table) -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..) ) where @@ -93,6 +126,7 @@ import qualified GHC.Data.Strict as Strict import GHC.Utils.Outputable( JoinPointHood(..) ) import Control.DeepSeq +import Control.Monad ( when, (<$!>), unless, forM_, void ) import Foreign hiding (shiftL, shiftR, void) import Data.Array import Data.Array.IO @@ -104,11 +138,14 @@ import Data.IORef import Data.Char ( ord, chr ) import Data.List.NonEmpty ( NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Data.Set ( Set ) import qualified Data.Set as Set import Data.Time +import Data.Tuple (swap) import Data.List (unfoldr) -import Control.Monad ( when, (<$!>), unless, forM_, void ) +import Data.Typeable import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Error ( mkIOError, eofErrorType ) @@ -119,6 +156,8 @@ import qualified Data.IntMap as IntMap import GHC.ForeignPtr ( unsafeWithForeignPtr ) #endif +import Unsafe.Coerce (unsafeCoerce) + type BinArray = ForeignPtr Word8 #if !MIN_VERSION_base(4,15,0) @@ -150,49 +189,83 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_usr :: UserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: !WriterUserData, + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getUserData :: BinHandle -> UserData -getUserData bh = bh_usr bh +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: !ReaderUserData, + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) + } + +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh + +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh + +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } -setUserData :: BinHandle -> UserData -> BinHandle -setUserData bh us = bh { bh_usr = us } +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } + +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle +addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) + } + } + +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle +addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) + } + } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -211,23 +284,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -235,42 +308,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } + +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -279,20 +367,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -313,7 +404,7 @@ expandBin (BinMem _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -329,7 +420,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -350,8 +441,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -372,39 +463,37 @@ putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -412,7 +501,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -425,7 +514,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -437,7 +526,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -458,10 +547,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -484,15 +573,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -509,15 +598,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -533,15 +622,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -561,15 +650,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -980,63 +1069,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1044,14 +1133,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1062,7 +1151,9 @@ lazyGetMaybe bh = do -- UserData -- ----------------------------------------------------------------------------- --- | Information we keep around during interface file +-- Note [Binary UserData] +-- ~~~~~~~~~~~~~~~~~~~~~~ +-- Information we keep around during interface file -- serialization/deserialization. Namely we keep the functions for serializing -- and deserializing 'Name's and 'FastString's. We do this because we actually -- use serialization in two distinct settings, @@ -1081,73 +1172,254 @@ lazyGetMaybe bh = do -- non-binding Name is serialized as the fingerprint of the thing they -- represent. See Note [Fingerprinting IfaceDecls] for further discussion. -- -data UserData = - UserData { - -- for *deserialising* only: - ud_get_name :: BinHandle -> IO Name, - ud_get_fs :: BinHandle -> IO FastString, - - -- for *serialising* only: - ud_put_nonbinding_name :: BinHandle -> Name -> IO (), - -- ^ serialize a non-binding 'Name' (e.g. a reference to another - -- binding). - ud_put_binding_name :: BinHandle -> Name -> IO (), - -- ^ serialize a binding 'Name' (e.g. the name of an IfaceDecl) - ud_put_fs :: BinHandle -> FastString -> IO () + +-- | Existential for 'BinaryWriter' with a type witness. +data SomeBinaryWriter = forall a . SomeBinaryWriter TypeRep (BinaryWriter a) + +-- | Existential for 'BinaryReader' with a type witness. +data SomeBinaryReader = forall a . SomeBinaryReader TypeRep (BinaryReader a) + +-- | UserData required to serialise symbols for interface files. +-- +-- See Note [Binary UserData] +data WriterUserData = + WriterUserData { + ud_writer_data :: Map TypeRep SomeBinaryWriter + -- ^ A mapping from a type witness to the 'Writer' for the associated type. + -- This is a 'Map' because microbenchmarks indicated this is more efficient + -- than other representations for less than ten elements. + -- + -- Considered representations: + -- + -- * [(TypeRep, SomeBinaryWriter)] + -- * bytehash (on hackage) + -- * Map TypeRep SomeBinaryWriter } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) - -> UserData -newReadState get_name get_fs - = UserData { ud_get_name = get_name, - ud_get_fs = get_fs, - ud_put_nonbinding_name = undef "put_nonbinding_name", - ud_put_binding_name = undef "put_binding_name", - ud_put_fs = undef "put_fs" - } - -newWriteState :: (BinHandle -> Name -> IO ()) - -- ^ how to serialize non-binding 'Name's - -> (BinHandle -> Name -> IO ()) +-- | UserData required to deserialise symbols for interface files. +-- +-- See Note [Binary UserData] +data ReaderUserData = + ReaderUserData { + ud_reader_data :: Map TypeRep SomeBinaryReader + -- ^ A mapping from a type witness to the 'Reader' for the associated type. + -- This is a 'Map' because microbenchmarks indicated this is more efficient + -- than other representations for less than ten elements. + -- + -- Considered representations: + -- + -- * [(TypeRep, SomeBinaryReader)] + -- * bytehash (on hackage) + -- * Map TypeRep SomeBinaryReader + } + +mkWriterUserData :: [SomeBinaryWriter] -> WriterUserData +mkWriterUserData caches = noWriterUserData + { ud_writer_data = Map.fromList $ map (\cache@(SomeBinaryWriter typRep _) -> (typRep, cache)) caches + } + +mkReaderUserData :: [SomeBinaryReader] -> ReaderUserData +mkReaderUserData caches = noReaderUserData + { ud_reader_data = Map.fromList $ map (\cache@(SomeBinaryReader typRep _) -> (typRep, cache)) caches + } + +mkSomeBinaryWriter :: forall a . Typeable a => BinaryWriter a -> SomeBinaryWriter +mkSomeBinaryWriter cb = SomeBinaryWriter (typeRep (Proxy :: Proxy a)) cb + +mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReader +mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb + +data BinaryReader s = BinaryReader + { getEntry :: ReadBinHandle -> IO s + } + +data BinaryWriter s = BinaryWriter + { putEntry :: WriteBinHandle -> s -> IO () + } + +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter f = BinaryWriter + { putEntry = f + } + +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s +mkReader f = BinaryReader + { getEntry = f + } + +findUserDataReader :: forall a . Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a +findUserDataReader query bh = + case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of + Nothing -> panic $ "Failed to find BinaryReader for key " ++ show (typeRep query) + Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> + unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader + +findUserDataWriter :: forall a . Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a +findUserDataWriter query bh = + case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of + Nothing -> panic $ "Failed to find BinaryWriter for key " ++ show (typeRep query) + Just (SomeBinaryWriter _ (writer :: BinaryWriter x)) -> + unsafeCoerce @(BinaryWriter x) @(BinaryWriter a) writer + +noReaderUserData :: ReaderUserData +noReaderUserData = ReaderUserData + { ud_reader_data = Map.empty + } + +noWriterUserData :: WriterUserData +noWriterUserData = WriterUserData + { ud_writer_data = Map.empty + } + +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) + -> ReaderUserData +newReadState get_name get_fs = + mkReaderUserData + [ mkSomeBinaryReader $ mkReader get_name + , mkSomeBinaryReader $ mkReader get_fs + ] + +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) - -> UserData -newWriteState put_nonbinding_name put_binding_name put_fs - = UserData { ud_get_name = undef "get_name", - ud_get_fs = undef "get_fs", - ud_put_nonbinding_name = put_nonbinding_name, - ud_put_binding_name = put_binding_name, - ud_put_fs = put_fs - } - -noUserData :: UserData -noUserData = UserData - { ud_get_name = undef "get_name" - , ud_get_fs = undef "get_fs" - , ud_put_nonbinding_name = undef "put_nonbinding_name" - , ud_put_binding_name = undef "put_binding_name" - , ud_put_fs = undef "put_fs" + -> (WriteBinHandle -> FastString -> IO ()) + -> WriterUserData +newWriteState put_binding_name put_fs = + mkWriterUserData + [ mkSomeBinaryWriter $ mkWriter put_binding_name + , mkSomeBinaryWriter $ mkWriter put_fs + ] + +-- ---------------------------------------------------------------------------- +-- Types for lookup and deduplication tables. +-- ---------------------------------------------------------------------------- + +data SomeReaderTable f = forall a . Typeable a => + SomeReaderTable (f (ReaderTable a)) + +data SomeWriterTable f = forall a . Typeable a => + SomeWriterTable (f (WriterTable, BinaryWriter a)) + +data ReaderTable a = ReaderTable + { getTable :: ReadBinHandle -> IO (SymbolTable a) + , mkReaderFromTable :: SymbolTable a -> BinaryReader a } -undef :: String -> a -undef s = panic ("Binary.UserData: no " ++ s) +data WriterTable = WriterTable + { putTable :: WriteBinHandle -> IO Int + } + +-- ---------------------------------------------------------------------------- +-- Common data structures for constructing and maintaining lookup tables for +-- binary serialisation and deserialisation. +-- ---------------------------------------------------------------------------- + +data GenericSymbolTable a = GenericSymbolTable + { gen_symtab_next :: !FastMutInt + -- ^ The next index to use + , gen_symtab_map :: !(IORef (Map.Map a Int)) + -- ^ Given a symbol, find the symbol + } + +initGenericSymbolTable :: IO (GenericSymbolTable a) +initGenericSymbolTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef Map.empty + pure $ GenericSymbolTable + { gen_symtab_next = symtab_next + , gen_symtab_map = symtab_map + } + +putGenericSymbolTable :: forall a. GenericSymbolTable a -> (BinHandle -> a -> IO ()) -> BinHandle -> IO Int +putGenericSymbolTable gen_sym_tab serialiser bh = do + table_count <- readFastMutInt symtab_next + symtab_map <- readIORef symtab_map + putGenericSymbolTable bh table_count symtab_map + pure table_count + where + symtab_map = gen_symtab_map gen_sym_tab + symtab_next = gen_symtab_next gen_sym_tab + putGenericSymbolTable :: BinHandle -> Int -> Map.Map a Int -> IO () + putGenericSymbolTable bh name_count symtab = do + put_ bh name_count + let genElements = elems (array (0,name_count-1) (fmap swap $ Map.toList symtab)) + mapM_ (\n -> serialiser bh n) genElements + +getGenericSymbolTable :: forall a. (BinHandle -> IO a) -> BinHandle -> IO (SymbolTable a) +getGenericSymbolTable deserialiser bh = do + sz <- get bh :: IO Int + mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int a) + forM_ [0..(sz-1)] $ \i -> do + f <- deserialiser bh + writeArray mut_arr i f + unsafeFreeze mut_arr + +putGenericSymTab :: (Ord a, Binary a) => GenericSymbolTable a -> BinHandle -> a -> IO () +putGenericSymTab GenericSymbolTable{ + gen_symtab_map = symtab_map_ref, + gen_symtab_next = symtab_next } + bh val = do + symtab_map <- readIORef symtab_map_ref + case Map.lookup val symtab_map of + Just off -> put_ bh (fromIntegral off :: Word32) + Nothing -> do + off <- readFastMutInt symtab_next + writeFastMutInt symtab_next (off+1) + writeIORef symtab_map_ref + $! Map.insert val off symtab_map + put_ bh (fromIntegral off :: Word32) + +getGenericSymtab :: Binary a => SymbolTable a + -> BinHandle -> IO a +getGenericSymtab symtab bh = do + i :: Word32 <- get bh + return $! symtab ! fromIntegral i --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- -type Dictionary = Array Int FastString -- The dictionary - -- Should be 0-indexed +-- | A 'SymbolTable' of 'FastString's. +type Dictionary = SymbolTable FastString + +initFastStringReaderTable :: IO (ReaderTable FastString) +initFastStringReaderTable = do + return $ + ReaderTable + { getTable = getDictionary + , mkReaderFromTable = \tbl -> mkReader (getDictFastString tbl) + } -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +initFastStringWriterTable :: IO (WriterTable, BinaryWriter FastString) +initFastStringWriterTable = do + dict_next_ref <- newFastMutInt 0 + dict_map_ref <- newIORef emptyUFM + let bin_dict = + FSTable + { fs_tab_next = dict_next_ref + , fs_tab_map = dict_map_ref + } + let put_dict bh = do + fs_count <- readFastMutInt dict_next_ref + dict_map <- readIORef dict_map_ref + putDictionary bh fs_count dict_map + pure fs_count + + return + ( WriterTable + { putTable = put_dict + } + , mkWriter $ putDictFastString bin_dict + ) + +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1156,34 +1428,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) - -initFSTable :: BinHandle -> IO (BinHandle, FSTable, IO Int) -initFSTable bh = do - dict_next_ref <- newFastMutInt 0 - dict_map_ref <- newIORef emptyUFM - let bin_dict = FSTable - { fs_tab_next = dict_next_ref - , fs_tab_map = dict_map_ref - } - let put_dict = do - fs_count <- readFastMutInt dict_next_ref - dict_map <- readIORef dict_map_ref - putDictionary bh fs_count dict_map - pure fs_count - - -- BinHandle with FastString writing support - let ud = getUserData bh - let ud_fs = ud { ud_put_fs = putDictFastString bin_dict } - let bh_fs = setUserData bh ud_fs - - return (bh_fs,bin_dict,put_dict) - -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1212,43 +1462,42 @@ data FSTable = FSTable { fs_tab_next :: !FastMutInt -- The next index to use -- The Symbol Table --------------------------------------------------------- --- On disk, the symbol table is an array of IfExtName, when --- reading it in we turn it into a SymbolTable. - -type SymbolTable = Array Int Name +-- | Symbols that are read from disk. +-- The 'SymbolTable' index starts on '0'. +type SymbolTable a = Array Int a --------------------------------------------------------- -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do @@ -1260,12 +1509,12 @@ instance Binary ByteString where instance Binary FastString where put_ bh f = - case getUserData bh of - UserData { ud_put_fs = put_fs } -> put_fs bh f + case findUserDataWriter (Proxy :: Proxy FastString) bh of + tbl -> putEntry tbl bh f get bh = - case getUserData bh of - UserData { ud_get_fs = get_fs } -> get_fs bh + case findUserDataReader (Proxy :: Proxy FastString) bh of + tbl -> getEntry tbl bh deriving instance Binary NonDetFastString deriving instance Binary LexicalFastString ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe +Subproject commit 799390d1c6d59a606c3dd00dea057baa26ed0c2f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/462541610e53b4fa54b6c67a361e730fedab62d9...aa3ccba8f9c84e141377908e96dd832c173d2267 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/462541610e53b4fa54b6c67a361e730fedab62d9...aa3ccba8f9c84e141377908e96dd832c173d2267 You're receiving 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 Apr 2 11:00:22 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 02 Apr 2024 07:00:22 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 2 commits: fixup! rts: Make addDLL a wrapper around loadNativeObj Message-ID: <660be546ee39f_26e1f6864b106609@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 38971885 by Rodrigo Mesquita at 2024-04-02T10:12:11+01:00 fixup! rts: Make addDLL a wrapper around loadNativeObj - - - - - fa4973f4 by Rodrigo Mesquita at 2024-04-02T11:59:56+01:00 fixup! fixup! rts: Make addDLL a wrapper around loadNativeObj - - - - - 4 changed files: - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== rts/Linker.c ===================================== @@ -643,7 +643,13 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; @@ -652,7 +658,6 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,18 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r = addDLL_PEi386(path, NULL); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1883,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,3 +1,5 @@ +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + #include "CheckUnload.h" #include "ForeignExports.h" #include "LinkerInternals.h" @@ -208,4 +210,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1141,47 +1141,55 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent); + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+1,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent) /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ba67d90e6af52e2a564cac74c902828f8fc05a9...fa4973f496050e7ade469f09205c4629d8894a80 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ba67d90e6af52e2a564cac74c902828f8fc05a9...fa4973f496050e7ade469f09205c4629d8894a80 You're receiving 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 Apr 2 11:14:14 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 07:14:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fendor/ghci-mi-extra-decls Message-ID: <660be8864aefe_26e1f6ab38e472664@gitlab.mail> Hannes Siebenhandl pushed new branch wip/fendor/ghci-mi-extra-decls at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/ghci-mi-extra-decls You're receiving 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 Apr 2 11:41:38 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 07:41:38 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fendor/os-string-modlocation Message-ID: <660beef264f5c_26e1f6d9b4d08058@gitlab.mail> Hannes Siebenhandl pushed new branch wip/fendor/os-string-modlocation at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/os-string-modlocation You're receiving 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 Apr 2 11:49:10 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 07:49:10 -0400 Subject: [Git][ghc/ghc][wip/fendor/os-string-modlocation] Migrate `Finder` component to `OsPath` Message-ID: <660bf0b6b9f93_26e1f6f0224c84318@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/os-string-modlocation at Glasgow Haskell Compiler / GHC Commits: cc35cf02 by Fendor at 2024-04-02T13:48:50+02:00 Migrate `Finder` component to `OsPath` For each module in a GHCi session, we keep alive one `ModLocation`. A `ModLocation` is fairly inefficiently packed, as `String`s are expensive in memory usage. While benchmarking the agda codebase, we concluded that we keep alive around 11MB of `FilePath`'s, solely retained by `ModLocation`. We provide a more densely packed encoding of `ModLocation`, by moving from `FilePath` to `OsPath`. Further, we migrate the full `Finder` component to `OsPath` to avoid unnecessary transformations. As the `Finder` component is well-encapsuled, this requires only a minimal amount of changes in other modules. Bump to haddock submodule for `ModLocation` changes. - - - - - 17 changed files: - compiler/GHC.hs - + compiler/GHC/Data/OsPath.hs - compiler/GHC/Data/Strict.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Location.hs - compiler/ghc.cabal.in - utils/haddock Changes: ===================================== compiler/GHC.hs ===================================== @@ -76,6 +76,12 @@ module GHC ( ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries, mgLookupModule, ModSummary(..), ms_mod_name, ModLocation(..), + ml_hs_file, + ml_hi_file, + ml_dyn_hi_file, + ml_obj_file, + ml_dyn_obj_file, + ml_hie_file, getModSummary, getModuleGraph, isLoaded, ===================================== compiler/GHC/Data/OsPath.hs ===================================== @@ -0,0 +1,19 @@ +module GHC.Data.OsPath + ( + -- * OsPath initialisation and transformation + OsPath + , unsafeDecodeUtf + , unsafeEncodeUtf + -- * Common utility functions + , () + , (<.>) + ) + where + +import GHC.Prelude + +import System.OsPath +import Data.Either + +unsafeDecodeUtf :: OsPath -> FilePath +unsafeDecodeUtf = fromRight (error "unsafeEncodeUtf: Internal error") . decodeUtf ===================================== compiler/GHC/Data/Strict.hs ===================================== @@ -9,8 +9,11 @@ module GHC.Data.Strict ( Maybe(Nothing, Just), fromMaybe, + GHC.Data.Strict.maybe, Pair(And), - + expectJust, + fromLazy, + toLazy, -- Not used at the moment: -- -- Either(Left, Right), @@ -18,9 +21,12 @@ module GHC.Data.Strict ( ) where import GHC.Prelude hiding (Maybe(..), Either(..)) +import GHC.Stack.Types + import Control.Applicative import Data.Semigroup import Data.Data +import qualified Data.Maybe as Lazy data Maybe a = Nothing | Just !a deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data) @@ -29,6 +35,10 @@ fromMaybe :: a -> Maybe a -> a fromMaybe d Nothing = d fromMaybe _ (Just x) = x +maybe :: b -> (a -> b) -> Maybe a -> b +maybe d _ Nothing = d +maybe _ f (Just x) = f x + apMaybe :: Maybe (a -> b) -> Maybe a -> Maybe b apMaybe (Just f) (Just x) = Just (f x) apMaybe _ _ = Nothing @@ -37,6 +47,19 @@ altMaybe :: Maybe a -> Maybe a -> Maybe a altMaybe Nothing r = r altMaybe l _ = l +fromLazy :: Lazy.Maybe a -> Maybe a +fromLazy (Lazy.Just a) = Just a +fromLazy Lazy.Nothing = Nothing + +toLazy :: Maybe a -> Lazy.Maybe a +toLazy (Just a) = Lazy.Just a +toLazy Nothing = Lazy.Nothing + +expectJust :: HasCallStack => String -> Maybe a -> a +{-# INLINE expectJust #-} +expectJust _ (Just x) = x +expectJust err Nothing = error ("expectJust " ++ err) + instance Semigroup a => Semigroup (Maybe a) where Nothing <> b = b a <> Nothing = a ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -74,6 +74,7 @@ import GHC.Linker.Types import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Maybe +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Data.StringBuffer import GHC.Data.FastString import qualified GHC.Data.EnumSet as EnumSet @@ -772,7 +773,7 @@ summariseRequirement pn mod_name = do let PackageName pn_fs = pn let location = mkHomeModLocation2 fopts mod_name - (unpackFS pn_fs moduleNameSlashes mod_name) "hsig" + (unsafeEncodeUtf $ unpackFS pn_fs moduleNameSlashes mod_name) (unsafeEncodeUtf "hsig") env <- getBkpEnv src_hash <- liftIO $ getFileHash (bkp_filename env) @@ -855,12 +856,12 @@ hsModuleToModSummary home_keys pn hsc_src modname -- these filenames to figure out where the hi files go. -- A travesty! let location0 = mkHomeModLocation2 fopts modname - (unpackFS unit_fs + (unsafeEncodeUtf $ unpackFS unit_fs moduleNameSlashes modname) (case hsc_src of - HsigFile -> "hsig" - HsBootFile -> "hs-boot" - HsSrcFile -> "hs") + HsigFile -> unsafeEncodeUtf "hsig" + HsBootFile -> unsafeEncodeUtf "hs-boot" + HsSrcFile -> unsafeEncodeUtf "hs") -- DANGEROUS: bootifying can POISON the module finder cache let location = case hsc_src of HsBootFile -> addBootSuffixLocnOut location0 ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Driver.Ppr import GHC.Driver.Backend +import GHC.Data.OsPath import qualified GHC.Data.ShortText as ST import GHC.Data.Stream ( Stream ) import qualified GHC.Data.Stream as Stream @@ -259,7 +260,7 @@ outputForeignStubs Maybe FilePath) -- C file created outputForeignStubs logger tmpfs dflags unit_state mod location stubs = do - let stub_h = mkStubPaths (initFinderOpts dflags) (moduleName mod) location + let stub_h = unsafeDecodeUtf $ mkStubPaths (initFinderOpts dflags) (moduleName mod) location stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" case stubs of ===================================== compiler/GHC/Driver/Config/Finder.hs ===================================== @@ -5,30 +5,31 @@ module GHC.Driver.Config.Finder ( import GHC.Prelude +import qualified GHC.Data.Strict as Strict import GHC.Driver.DynFlags import GHC.Unit.Finder.Types import GHC.Data.FastString - +import GHC.Data.OsPath -- | Create a new 'FinderOpts' from DynFlags. initFinderOpts :: DynFlags -> FinderOpts initFinderOpts flags = FinderOpts - { finder_importPaths = importPaths flags + { finder_importPaths = fmap unsafeEncodeUtf $ importPaths flags , finder_lookupHomeInterfaces = isOneShot (ghcMode flags) , finder_bypassHiFileCheck = MkDepend == (ghcMode flags) , finder_ways = ways flags , finder_enableSuggestions = gopt Opt_HelpfulErrors flags - , finder_workingDirectory = workingDirectory flags + , finder_workingDirectory = fmap unsafeEncodeUtf $ Strict.fromLazy $ workingDirectory flags , finder_thisPackageName = mkFastString <$> thisPackageName flags , finder_hiddenModules = hiddenModules flags , finder_reexportedModules = reexportedModules flags - , finder_hieDir = hieDir flags - , finder_hieSuf = hieSuf flags - , finder_hiDir = hiDir flags - , finder_hiSuf = hiSuf_ flags - , finder_dynHiSuf = dynHiSuf_ flags - , finder_objectDir = objectDir flags - , finder_objectSuf = objectSuf_ flags - , finder_dynObjectSuf = dynObjectSuf_ flags - , finder_stubDir = stubDir flags + , finder_hieDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hieDir flags + , finder_hieSuf = unsafeEncodeUtf $ hieSuf flags + , finder_hiDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hiDir flags + , finder_hiSuf = unsafeEncodeUtf $ hiSuf_ flags + , finder_dynHiSuf = unsafeEncodeUtf $ dynHiSuf_ flags + , finder_objectDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ objectDir flags + , finder_objectSuf = unsafeEncodeUtf $ objectSuf_ flags + , finder_dynObjectSuf = unsafeEncodeUtf $ dynObjectSuf_ flags + , finder_stubDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ stubDir flags } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -264,6 +264,8 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString import GHC.Data.Bag +import GHC.Data.OsPath (unsafeEncodeUtf) +import qualified GHC.Data.Strict as Strict import GHC.Data.StringBuffer import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) @@ -2106,12 +2108,12 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs rawCmms return stub_c_exists where - no_loc = ModLocation{ ml_hs_file = Just original_filename, - ml_hi_file = panic "hscCompileCmmFile: no hi file", - ml_obj_file = panic "hscCompileCmmFile: no obj file", - ml_dyn_obj_file = panic "hscCompileCmmFile: no dyn obj file", - ml_dyn_hi_file = panic "hscCompileCmmFile: no dyn obj file", - ml_hie_file = panic "hscCompileCmmFile: no hie file"} + no_loc = ModLocation{ ml_hs_file_ = Strict.Just $ unsafeEncodeUtf original_filename, + ml_hi_file_ = panic "hscCompileCmmFile: no hi file", + ml_obj_file_ = panic "hscCompileCmmFile: no obj file", + ml_dyn_obj_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_dyn_hi_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_hie_file_ = panic "hscCompileCmmFile: no hie file"} -------------------- Stuff for new code gen --------------------- @@ -2346,12 +2348,12 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do {- Desugar it -} -- We use a basically null location for iNTERACTIVE - let iNTERACTIVELoc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hsDeclsWithLocation:ml_hi_file", - ml_obj_file = panic "hsDeclsWithLocation:ml_obj_file", - ml_dyn_obj_file = panic "hsDeclsWithLocation:ml_dyn_obj_file", - ml_dyn_hi_file = panic "hsDeclsWithLocation:ml_dyn_hi_file", - ml_hie_file = panic "hsDeclsWithLocation:ml_hie_file" } + let iNTERACTIVELoc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hsDeclsWithLocation:ml_hi_file", + ml_obj_file_ = panic "hsDeclsWithLocation:ml_obj_file", + ml_dyn_obj_file_ = panic "hsDeclsWithLocation:ml_dyn_obj_file", + ml_dyn_hi_file_ = panic "hsDeclsWithLocation:ml_dyn_hi_file", + ml_hie_file_ = panic "hsDeclsWithLocation:ml_hie_file" } ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv {- Simplify -} @@ -2630,12 +2632,12 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- Lint if necessary -} lintInteractiveExpr (text "hscCompileCoreExpr") hsc_env prepd_expr - let this_loc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file", - ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file", - ml_dyn_obj_file = panic "hscCompileCoreExpr': ml_obj_file", - ml_dyn_hi_file = panic "hscCompileCoreExpr': ml_dyn_hi_file", - ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } + let this_loc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hscCompileCoreExpr':ml_hi_file", + ml_obj_file_ = panic "hscCompileCoreExpr':ml_obj_file", + ml_dyn_obj_file_ = panic "hscCompileCoreExpr': ml_obj_file", + ml_dyn_hi_file_ = panic "hscCompileCoreExpr': ml_dyn_hi_file", + ml_hie_file_ = panic "hscCompileCoreExpr':ml_hie_file" } -- Ensure module uniqueness by giving it a name like "GhciNNNN". -- This uniqueness is needed by the JS linker. Without it we break the 1-1 ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -72,10 +72,12 @@ import GHC.Iface.Load ( cannotFindModule ) import GHC.IfaceToCore ( typecheckIface ) import GHC.Iface.Recomp ( RecompileRequired(..), CompileReason(..) ) +import qualified GHC.Data.Strict as Strict import GHC.Data.Bag ( listToBag ) import GHC.Data.Graph.Directed import GHC.Data.FastString import GHC.Data.Maybe ( expectJust ) +import GHC.Data.OsPath ( unsafeEncodeUtf, unsafeDecodeUtf ) import GHC.Data.StringBuffer import qualified GHC.LanguageExtensions as LangExt @@ -336,12 +338,15 @@ warnMissingHomeModules dflags targets mod_graph = -> moduleName (ms_mod mod) == name && tuid == ms_unitid mod TargetFile target_file _ - | Just mod_file <- ml_hs_file (ms_location mod) + | Strict.Just mod_file <- ml_hs_file_ (ms_location mod) -> - augmentByWorkingDirectory dflags target_file == mod_file || + let + target_os_file = unsafeEncodeUtf target_file + in + augmentByWorkingDirectory dflags target_file == unsafeDecodeUtf mod_file || -- Don't warn on B.hs-boot if B.hs is specified (#16551) - addBootSuffix target_file == mod_file || + addBootSuffix target_os_file == mod_file || -- We can get a file target even if a module name was -- originally specified in a command line because it can @@ -1830,7 +1835,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf let dyn_tn = tn -<.> dynsuf addFilesToClean tmpfs dynLife [dyn_tn] - return (tn, dyn_tn) + return (unsafeEncodeUtf tn, unsafeEncodeUtf dyn_tn) -- We don't want to create .o or .hi files unless we have been asked -- to by the user. But we need them, so we patch their locations in -- the ModSummary with temporary files. @@ -1839,8 +1844,8 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- If ``-fwrite-interface` is specified, then the .o and .hi files -- are written into `-odir` and `-hidir` respectively. #16670 if gopt Opt_WriteInterface dflags - then return ((ml_hi_file ms_location, ml_dyn_hi_file ms_location) - , (ml_obj_file ms_location, ml_dyn_obj_file ms_location)) + then return ((ml_hi_file_ ms_location, ml_dyn_hi_file_ ms_location) + , (ml_obj_file_ ms_location, ml_dyn_obj_file_ ms_location)) else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) let new_dflags = case enable_spec of @@ -1849,10 +1854,10 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} let ms' = ms { ms_location = - ms_location { ml_hi_file = hi_file - , ml_obj_file = o_file - , ml_dyn_hi_file = dyn_hi_file - , ml_dyn_obj_file = dyn_o_file } + ms_location { ml_hi_file_ = hi_file + , ml_obj_file_ = o_file + , ml_dyn_hi_file_ = dyn_hi_file + , ml_dyn_obj_file_ = dyn_o_file } , ms_hspp_opts = updOptLevel 0 $ new_dflags } -- Recursive call to catch the other cases @@ -2037,7 +2042,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf let fopts = initFinderOpts (hsc_dflags hsc_env) -- Make a ModLocation for this file - let location = mkHomeModLocation fopts pi_mod_name src_fn + let location = mkHomeModLocation fopts pi_mod_name (unsafeEncodeUtf src_fn) -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Driver.Env import GHC.Driver.Errors.Types import qualified GHC.SysTools as SysTools import GHC.Data.Graph.Directed ( SCC(..) ) +import GHC.Data.OsPath (unsafeDecodeUtf) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SourceError @@ -297,7 +298,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do Found loc _ -- Home package: just depend on the .hi or hi-boot file | isJust (ml_hs_file loc) || include_pkg_deps - -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc))) + -> return (Just (unsafeDecodeUtf $ addBootSuffix_maybe is_boot (ml_hi_file_ loc))) -- Not in this package: we don't need a dependency | otherwise ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -58,6 +58,7 @@ import GHC.Iface.Make import GHC.Driver.Config.Parser import GHC.Parser.Header import GHC.Data.StringBuffer +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Types.SourceError import GHC.Unit.Finder import Data.IORef @@ -759,7 +760,7 @@ mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO Mod mkOneShotModLocation pipe_env dflags src_flavour mod_name = do let PipeEnv{ src_basename=basename, src_suffix=suff } = pipe_env - let location1 = mkHomeModLocation2 fopts mod_name basename suff + let location1 = mkHomeModLocation2 fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff) -- Boot-ify it if necessary let location2 @@ -771,11 +772,11 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do -- This can't be done in mkHomeModuleLocation because -- it only applies to the module being compiles let ohi = outputHi dflags - location3 | Just fn <- ohi = location2{ ml_hi_file = fn } + location3 | Just fn <- ohi = location2{ ml_hi_file_ = unsafeEncodeUtf fn } | otherwise = location2 let dynohi = dynOutputHi dflags - location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file = fn } + location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file_ = unsafeEncodeUtf fn } | otherwise = location3 -- Take -o into account if present @@ -789,10 +790,10 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do location5 | Just ofile <- expl_o_file , let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file , isNoLink (ghcLink dflags) - = location4 { ml_obj_file = ofile - , ml_dyn_obj_file = dyn_ofile } + = location4 { ml_obj_file_ = unsafeEncodeUtf ofile + , ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | Just dyn_ofile <- expl_dyn_o_file - = location4 { ml_dyn_obj_file = dyn_ofile } + = location4 { ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | otherwise = location4 return location5 where ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Utils.Panic.Plain import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Data.Maybe +import GHC.Data.OsPath import GHC.Prelude import GHC.Unit import GHC.Unit.Env @@ -55,13 +56,13 @@ cantFindInstalledErr unit_state mhome_unit profile mod_name find_result InstalledNotFound files mb_pkg | Just pkg <- mb_pkg , notHomeUnitId mhome_unit pkg - -> not_found_in_package pkg files + -> not_found_in_package pkg $ fmap unsafeDecodeUtf files | null files -> NotAModule | otherwise - -> CouldntFindInFiles files + -> CouldntFindInFiles $ fmap unsafeDecodeUtf files _ -> panic "cantFindInstalledErr" ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -300,7 +300,7 @@ mkIface_ hsc_env trust_info = setSafeMode safe_mode annotations = map mkIfaceAnnotation anns icomplete_matches = map mkIfaceCompleteMatch complete_matches - !rdrs = maybeGlobalRdrEnv rdr_env + _ = maybeGlobalRdrEnv rdr_env ModIface { mi_module = this_mod, @@ -323,7 +323,7 @@ mkIface_ hsc_env mi_fixities = fixities, mi_warns = warns, mi_anns = annotations, - mi_globals = rdrs, + mi_globals = Nothing, mi_used_th = used_th, mi_decls = decls, mi_extra_decls = extra_decls, ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -42,6 +42,9 @@ import GHC.Platform.Ways import GHC.Builtin.Names ( gHC_PRIM ) +import qualified GHC.Data.Strict as Strict +import GHC.Data.OsPath + import GHC.Unit.Env import GHC.Unit.Types import GHC.Unit.Module @@ -49,7 +52,6 @@ import GHC.Unit.Home import GHC.Unit.State import GHC.Unit.Finder.Types -import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.ShortText as ST import GHC.Utils.Misc @@ -61,8 +63,7 @@ import GHC.Types.PkgQual import GHC.Fingerprint import Data.IORef -import System.Directory -import System.FilePath +import System.Directory.OsPath import Control.Monad import Data.Time import qualified Data.Map as M @@ -70,9 +71,10 @@ import GHC.Driver.Env ( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env) ) import GHC.Driver.Config.Finder import qualified Data.Set as Set +import qualified System.OsPath as OsPath -type FileExt = String -- Filename extension -type BaseName = String -- Basename of file +type FileExt = OsPath -- Filename extension +type BaseName = OsPath -- Basename of file -- ----------------------------------------------------------------------------- -- The Finder @@ -286,7 +288,7 @@ findLookupResult fc fopts r = case r of -- implicit locations from the instances InstalledFound loc _ -> return (Found loc m) InstalledNoPackage _ -> return (NoPackage (moduleUnit m)) - InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m) + InstalledNotFound fp _ -> return (NotFound{ fr_paths = fmap unsafeDecodeUtf fp, fr_pkg = Just (moduleUnit m) , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_unusables = [] @@ -357,7 +359,7 @@ findHomeModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -382,7 +384,7 @@ findHomePackageModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkModule uid mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -413,22 +415,22 @@ findInstalledHomeModule fc fopts home_unit mod_name = do let maybe_working_dir = finder_workingDirectory fopts home_path = case maybe_working_dir of - Nothing -> finder_importPaths fopts - Just fp -> augmentImports fp (finder_importPaths fopts) + Strict.Nothing -> finder_importPaths fopts + Strict.Just fp -> augmentImports fp (finder_importPaths fopts) hi_dir_path = case finder_hiDir fopts of - Just hiDir -> case maybe_working_dir of - Nothing -> [hiDir] - Just fp -> [fp hiDir] - Nothing -> home_path + Strict.Just hiDir -> case maybe_working_dir of + Strict.Nothing -> [hiDir] + Strict.Just fp -> [fp hiDir] + Strict.Nothing -> home_path hisuf = finder_hiSuf fopts mod = mkModule home_unit mod_name source_exts = - [ ("hs", mkHomeModLocationSearched fopts mod_name "hs") - , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs") - , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig") - , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig") + [ (unsafeEncodeUtf "hs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hs") + , (unsafeEncodeUtf "lhs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhs") + , (unsafeEncodeUtf "hsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hsig") + , (unsafeEncodeUtf "lhsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhsig") ] -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that @@ -453,9 +455,9 @@ findInstalledHomeModule fc fopts home_unit mod_name = do else searchPathExts search_dirs mod exts -- | Prepend the working directory to the search path. -augmentImports :: FilePath -> [FilePath] -> [FilePath] +augmentImports :: OsPath -> [OsPath] -> [OsPath] augmentImports _work_dir [] = [] -augmentImports work_dir (fp:fps) | isAbsolute fp = fp : augmentImports work_dir fps +augmentImports work_dir (fp:fps) | OsPath.isAbsolute fp = fp : augmentImports work_dir fps | otherwise = (work_dir fp) : augmentImports work_dir fps -- | Search for a module in external packages only. @@ -488,14 +490,14 @@ findPackageModule_ fc fopts mod pkg_conf = do tag = waysBuildTag (finder_ways fopts) -- hi-suffix for packages depends on the build tag. - package_hisuf | null tag = "hi" - | otherwise = tag ++ "_hi" + package_hisuf | null tag = unsafeEncodeUtf $ "hi" + | otherwise = unsafeEncodeUtf $ tag ++ "_hi" - package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" + package_dynhisuf = unsafeEncodeUtf $ waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf package_dynhisuf - import_dirs = map ST.unpack $ unitImportDirs pkg_conf + import_dirs = map (unsafeEncodeUtf . ST.unpack) $ unitImportDirs pkg_conf -- we never look for a .hi-boot file in an external package; -- .hi-boot files only make sense for the home package. in @@ -503,7 +505,7 @@ findPackageModule_ fc fopts mod pkg_conf = do [one] | finder_bypassHiFileCheck fopts -> -- there's only one place that this .hi file can be, so -- don't bother looking for it. - let basename = moduleNameSlashes (moduleName mod) + let basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) loc = mk_hi_loc one basename in return $ InstalledFound loc mod _otherwise -> @@ -512,24 +514,24 @@ findPackageModule_ fc fopts mod pkg_conf = do -- ----------------------------------------------------------------------------- -- General path searching -searchPathExts :: [FilePath] -- paths to search +searchPathExts :: [OsPath] -- paths to search -> InstalledModule -- module name -> [ ( FileExt, -- suffix - FilePath -> BaseName -> ModLocation -- action + OsPath -> BaseName -> ModLocation -- action ) ] -> IO InstalledFindResult searchPathExts paths mod exts = search to_search where - basename = moduleNameSlashes (moduleName mod) + basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) - to_search :: [(FilePath, ModLocation)] + to_search :: [(OsPath, ModLocation)] to_search = [ (file, fn path basename) | path <- paths, (ext,fn) <- exts, - let base | path == "." = basename + let base | path == unsafeEncodeUtf "." = basename | otherwise = path basename file = base <.> ext ] @@ -543,7 +545,7 @@ searchPathExts paths mod exts = search to_search else search rest mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt - -> FilePath -> BaseName -> ModLocation + -> OsPath -> BaseName -> ModLocation mkHomeModLocationSearched fopts mod suff path basename = mkHomeModLocation2 fopts mod (path basename) suff @@ -581,18 +583,18 @@ mkHomeModLocationSearched fopts mod suff path basename = -- ext -- The filename extension of the source file (usually "hs" or "lhs"). -mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation +mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> ModLocation mkHomeModLocation dflags mod src_filename = - let (basename,extension) = splitExtension src_filename + let (basename,extension) = OsPath.splitExtension src_filename in mkHomeModLocation2 dflags mod basename extension mkHomeModLocation2 :: FinderOpts -> ModuleName - -> FilePath -- Of source module, without suffix - -> String -- Suffix + -> OsPath -- Of source module, without suffix + -> OsPath -- Suffix -> ModLocation mkHomeModLocation2 fopts mod src_basename ext = - let mod_basename = moduleNameSlashes mod + let mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod obj_fn = mkObjPath fopts src_basename mod_basename dyn_obj_fn = mkDynObjPath fopts src_basename mod_basename @@ -600,72 +602,72 @@ mkHomeModLocation2 fopts mod src_basename ext = dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename hie_fn = mkHiePath fopts src_basename mod_basename - in (ModLocation{ ml_hs_file = Just (src_basename <.> ext), - ml_hi_file = hi_fn, - ml_dyn_hi_file = dyn_hi_fn, - ml_obj_file = obj_fn, - ml_dyn_obj_file = dyn_obj_fn, - ml_hie_file = hie_fn }) + in (ModLocation{ ml_hs_file_ = Strict.Just (src_basename <.> ext), + ml_hi_file_ = hi_fn, + ml_dyn_hi_file_ = dyn_hi_fn, + ml_obj_file_ = obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, + ml_hie_file_ = hie_fn }) mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName - -> FilePath + -> OsPath -> BaseName -> ModLocation mkHomeModHiOnlyLocation fopts mod path basename = - let loc = mkHomeModLocation2 fopts mod (path basename) "" - in loc { ml_hs_file = Nothing } + let loc = mkHomeModLocation2 fopts mod (path basename) mempty + in loc { ml_hs_file_ = Strict.Nothing } -- This function is used to make a ModLocation for a package module. Hence why -- we explicitly pass in the interface file suffixes. -mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String +mkHiOnlyModLocation :: FinderOpts -> OsPath -> OsPath -> OsPath -> OsPath -> ModLocation mkHiOnlyModLocation fopts hisuf dynhisuf path basename = let full_basename = path basename obj_fn = mkObjPath fopts full_basename basename dyn_obj_fn = mkDynObjPath fopts full_basename basename hie_fn = mkHiePath fopts full_basename basename - in ModLocation{ ml_hs_file = Nothing, - ml_hi_file = full_basename <.> hisuf, + in ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = full_basename <.> hisuf, -- Remove the .hi-boot suffix from -- hi_file, if it had one. We always -- want the name of the real .hi file -- in the ml_hi_file field. - ml_dyn_obj_file = dyn_obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, -- MP: TODO - ml_dyn_hi_file = full_basename <.> dynhisuf, - ml_obj_file = obj_fn, - ml_hie_file = hie_fn + ml_dyn_hi_file_ = full_basename <.> dynhisuf, + ml_obj_file_ = obj_fn, + ml_hie_file_ = hie_fn } -- | Constructs the filename of a .o file for a given source file. -- Does /not/ check whether the .o file exists mkObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath -mkObjPath fopts basename mod_basename = obj_basename <.> osuf + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath +mkObjPath fopts basename mod_basename = obj_basename OsPath.<.> osuf where odir = finder_objectDir fopts osuf = finder_objectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir OsPath. mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_o file for a given source file. -- Does /not/ check whether the .dyn_o file exists mkDynObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf where odir = finder_objectDir fopts dynosuf = finder_dynObjectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir mod_basename | otherwise = basename @@ -673,45 +675,45 @@ mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf -- Does /not/ check whether the .hi file exists mkHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiPath fopts basename mod_basename = hi_basename <.> hisuf where hidir = finder_hiDir fopts hisuf = finder_hiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_hi file for a given source file. -- Does /not/ check whether the .dyn_hi file exists mkDynHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf where hidir = finder_hiDir fopts dynhisuf = finder_dynHiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .hie file for a given source file. -- Does /not/ check whether the .hie file exists mkHiePath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf where hiedir = finder_hieDir fopts hiesuf = finder_hieSuf fopts - hie_basename | Just dir <- hiedir = dir mod_basename + hie_basename | Strict.Just dir <- hiedir = dir mod_basename | otherwise = basename @@ -726,23 +728,23 @@ mkStubPaths :: FinderOpts -> ModuleName -> ModLocation - -> FilePath + -> OsPath mkStubPaths fopts mod location = let stubdir = finder_stubDir fopts - mod_basename = moduleNameSlashes mod - src_basename = dropExtension $ expectJust "mkStubPaths" - (ml_hs_file location) + mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod + src_basename = OsPath.dropExtension $ Strict.expectJust "mkStubPaths" + (ml_hs_file_ location) stub_basename0 - | Just dir <- stubdir = dir mod_basename + | Strict.Just dir <- stubdir = dir mod_basename | otherwise = src_basename - stub_basename = stub_basename0 ++ "_stub" + stub_basename = stub_basename0 `mappend` unsafeEncodeUtf "_stub" in - stub_basename <.> "h" + stub_basename <.> unsafeEncodeUtf "h" -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -9,6 +9,7 @@ where import GHC.Prelude import GHC.Unit +import qualified GHC.Data.Strict as Strict import qualified Data.Map as M import GHC.Fingerprint import GHC.Platform.Ways @@ -16,6 +17,7 @@ import GHC.Platform.Ways import Data.IORef import GHC.Data.FastString import qualified Data.Set as Set +import System.OsPath (OsPath) -- | The 'FinderCache' maps modules to the result of -- searching for that module. It records the results of searching for @@ -31,7 +33,7 @@ data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState) data InstalledFindResult = InstalledFound ModLocation InstalledModule | InstalledNoPackage UnitId - | InstalledNotFound [FilePath] (Maybe UnitId) + | InstalledNotFound [OsPath] (Maybe UnitId) -- | The result of searching for an imported module. -- @@ -70,7 +72,7 @@ data FindResult -- -- Should be taken from 'DynFlags' via 'initFinderOpts'. data FinderOpts = FinderOpts - { finder_importPaths :: [FilePath] + { finder_importPaths :: [OsPath] -- ^ Where are we allowed to look for Modules and Source files , finder_lookupHomeInterfaces :: Bool -- ^ When looking up a home module: @@ -88,17 +90,17 @@ data FinderOpts = FinderOpts , finder_enableSuggestions :: Bool -- ^ If we encounter unknown modules, should we suggest modules -- that have a similar name. - , finder_workingDirectory :: Maybe FilePath + , finder_workingDirectory :: Strict.Maybe OsPath , finder_thisPackageName :: Maybe FastString , finder_hiddenModules :: Set.Set ModuleName , finder_reexportedModules :: Set.Set ModuleName - , finder_hieDir :: Maybe FilePath - , finder_hieSuf :: String - , finder_hiDir :: Maybe FilePath - , finder_hiSuf :: String - , finder_dynHiSuf :: String - , finder_objectDir :: Maybe FilePath - , finder_objectSuf :: String - , finder_dynObjectSuf :: String - , finder_stubDir :: Maybe FilePath + , finder_hieDir :: Strict.Maybe OsPath + , finder_hieSuf :: OsPath + , finder_hiDir :: Strict.Maybe OsPath + , finder_hiSuf :: OsPath + , finder_dynHiSuf :: OsPath + , finder_objectDir :: Strict.Maybe OsPath + , finder_objectSuf :: OsPath + , finder_dynObjectSuf :: OsPath + , finder_stubDir :: Strict.Maybe OsPath } deriving Show ===================================== compiler/GHC/Unit/Module/Location.hs ===================================== @@ -7,12 +7,21 @@ module GHC.Unit.Module.Location , addBootSuffixLocn , addBootSuffixLocnOut , removeBootSuffix + , ml_hs_file + , ml_hi_file + , ml_dyn_hi_file + , ml_obj_file + , ml_dyn_obj_file + , ml_hie_file ) where import GHC.Prelude import GHC.Unit.Types import GHC.Utils.Outputable +import qualified GHC.Data.Strict as Strict +import System.OsPath +import GHC.Data.OsPath -- | Module Location -- @@ -39,30 +48,30 @@ import GHC.Utils.Outputable data ModLocation = ModLocation { - ml_hs_file :: Maybe FilePath, + ml_hs_file_ :: Strict.Maybe OsPath, -- ^ The source file, if we have one. Package modules -- probably don't have source files. - ml_hi_file :: FilePath, + ml_hi_file_ :: OsPath, -- ^ Where the .hi file is, whether or not it exists -- yet. Always of form foo.hi, even if there is an -- hi-boot file (we add the -boot suffix later) - ml_dyn_hi_file :: FilePath, + ml_dyn_hi_file_ :: OsPath, -- ^ Where the .dyn_hi file is, whether or not it exists -- yet. - ml_obj_file :: FilePath, + ml_obj_file_ :: OsPath, -- ^ Where the .o file is, whether or not it exists yet. -- (might not exist either because the module hasn't -- been compiled yet, or because it is part of a -- unit with a .a file) - ml_dyn_obj_file :: FilePath, + ml_dyn_obj_file_ :: OsPath, -- ^ Where the .dy file is, whether or not it exists -- yet. - ml_hie_file :: FilePath + ml_hie_file_ :: OsPath -- ^ Where the .hie file is, whether or not it exists -- yet. } deriving Show @@ -71,8 +80,8 @@ instance Outputable ModLocation where ppr = text . show -- | Add the @-boot@ suffix to .hs, .hi and .o files -addBootSuffix :: FilePath -> FilePath -addBootSuffix path = path ++ "-boot" +addBootSuffix :: OsPath -> OsPath +addBootSuffix path = path `mappend` unsafeEncodeUtf "-boot" -- | Remove the @-boot@ suffix to .hs, .hi and .o files removeBootSuffix :: FilePath -> FilePath @@ -82,7 +91,7 @@ removeBootSuffix [] = error "removeBootSuffix: no -boot suffix" -- | Add the @-boot@ suffix if the @Bool@ argument is @True@ -addBootSuffix_maybe :: IsBootInterface -> FilePath -> FilePath +addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath addBootSuffix_maybe is_boot path = case is_boot of IsBoot -> addBootSuffix path NotBoot -> path @@ -95,22 +104,42 @@ addBootSuffixLocn_maybe is_boot locn = case is_boot of -- | Add the @-boot@ suffix to all file paths associated with the module addBootSuffixLocn :: ModLocation -> ModLocation addBootSuffixLocn locn - = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn) - , ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) } + = locn { ml_hs_file_ = fmap addBootSuffix (ml_hs_file_ locn) + , ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } -- | Add the @-boot@ suffix to all output file paths associated with the -- module, not including the input file itself addBootSuffixLocnOut :: ModLocation -> ModLocation addBootSuffixLocnOut locn - = locn { ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) + = locn { ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } +-- ---------------------------------------------------------------------------- +-- Helpers for backwards compatibility +-- ---------------------------------------------------------------------------- +ml_hs_file :: ModLocation -> Maybe FilePath +ml_hs_file = fmap unsafeDecodeUtf . Strict.toLazy . ml_hs_file_ + +ml_hi_file :: ModLocation -> FilePath +ml_hi_file = unsafeDecodeUtf . ml_hi_file_ + +ml_dyn_hi_file :: ModLocation -> FilePath +ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ + +ml_obj_file :: ModLocation -> FilePath +ml_obj_file = unsafeDecodeUtf . ml_obj_file_ + +ml_dyn_obj_file :: ModLocation -> FilePath +ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ + +ml_hie_file :: ModLocation -> FilePath +ml_hie_file = unsafeDecodeUtf . ml_hie_file_ ===================================== compiler/ghc.cabal.in ===================================== @@ -428,6 +428,7 @@ Library GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList + GHC.Data.OsPath GHC.Data.Pair GHC.Data.SmallArray GHC.Data.Stream ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe +Subproject commit 1ef6c187b31f85dfd7133b150b211ec9140cc84a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc35cf024fa11cdab803de7c9290069dbf831d29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc35cf024fa11cdab803de7c9290069dbf831d29 You're receiving 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 Apr 2 11:51:41 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 07:51:41 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` Message-ID: <660bf14de6ec8_26e1f6100970885149@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: 1f19ba2b by Fendor at 2024-04-02T13:51:23+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 10 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -75,7 +75,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -137,7 +137,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -148,7 +148,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -156,7 +156,7 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do let -- The order of these entries matters! @@ -194,14 +194,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -211,7 +211,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -235,7 +235,7 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int, Int, b) +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) putWithTables bh' put_payload = do let -- The order of these entries matters! @@ -380,7 +380,7 @@ initWriteNameTable = do ) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -389,7 +389,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -410,7 +410,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -434,7 +434,7 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: BinSymbolTable -> BinHandle -> Name -> IO () +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } @@ -460,7 +460,7 @@ putName BinSymbolTable{ -- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name - -> BinHandle -> IO Name + -> ReadBinHandle -> IO Name getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -111,19 +111,19 @@ writeHieFile hie_file_path hiefile = do put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next symtab_map' <- readIORef symtab_map putSymbolTable bh symtab_next' symtab_map' - -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + -- write the tellBinWriter pointer at the front of the file + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -181,7 +181,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -190,7 +190,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -213,7 +213,7 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data @@ -232,21 +232,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -260,13 +260,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -276,12 +276,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable Name -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -334,7 +334,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -345,7 +345,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -37,7 +37,7 @@ computeFingerprint a = do -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -119,10 +119,10 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = case findUserDataWriter Proxy bh of tbl -> @@ -2445,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -89,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq -import Data.Proxy +import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -322,7 +322,7 @@ putObject bh mod_name deps os = do -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -330,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -345,7 +345,7 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) @@ -353,7 +353,7 @@ getObjectBody bh0 mod_name = do block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -364,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -393,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -409,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -779,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -31,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -87,7 +89,23 @@ module GHC.Utils.Binary initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, - +<<<<<<< HEAD + -- * Generic Symbol that can be used for user-defined deduplication tables. + GenericSymbolTable(..), + initGenericSymbolTable, + putGenericSymbolTable, getGenericSymbolTable, + putGenericSymTab, getGenericSymtab, +||||||| parent of f3fd018a62 (Fixup: Generic Symbol Table) + +======= + + -- * Generic Symbol that can be used for user-defined deduplication tables. + GenericSymbolTable(..), + initGenericSymbolTable, + putGenericSymbolTable, getGenericSymbolTable, + putGenericSymTab, getGenericSymtab, + +>>>>>>> f3fd018a62 (Fixup: Generic Symbol Table) -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..) ) where @@ -171,70 +189,83 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noReaderUserData noWriterUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_reader :: ReaderUserData, -- sigh, need parameterized modules :-) - bh_writer :: WriterUserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: !WriterUserData, + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) + } + +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: !ReaderUserData, + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getReaderUserData :: BinHandle -> ReaderUserData -getReaderUserData bh = bh_reader bh +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh -getWriterUserData :: BinHandle -> WriterUserData -getWriterUserData bh = bh_writer bh +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setWriterUserData :: BinHandle -> WriterUserData -> BinHandle -setWriterUserData bh us = bh { bh_writer = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } -setReaderUserData :: BinHandle -> ReaderUserData -> BinHandle -setReaderUserData bh us = bh { bh_reader = us } +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } -addReaderToUserData :: SomeBinaryReader -> BinHandle -> BinHandle +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh - { bh_reader = (bh_reader bh) - { ud_reader_data = Map.insert typRep cache (ud_reader_data (bh_reader bh)) + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) } } -addWriterToUserData :: SomeBinaryWriter -> BinHandle -> BinHandle +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh - { bh_writer = (bh_writer bh) - { ud_writer_data = Map.insert typRep cache (ud_writer_data (bh_writer bh)) + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) } } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -253,23 +284,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -277,42 +308,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) + +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -321,20 +367,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -355,7 +404,7 @@ expandBin (BinMem _ _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -371,7 +420,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -392,8 +441,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -414,39 +463,37 @@ putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -454,7 +501,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -467,7 +514,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -479,7 +526,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -500,10 +547,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -526,15 +573,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -551,15 +598,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -575,15 +622,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -603,15 +650,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -1022,63 +1069,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1086,14 +1133,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1183,31 +1230,31 @@ mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReade mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb data BinaryReader s = BinaryReader - { getEntry :: BinHandle -> IO s + { getEntry :: ReadBinHandle -> IO s } data BinaryWriter s = BinaryWriter - { putEntry :: BinHandle -> s -> IO () + { putEntry :: WriteBinHandle -> s -> IO () } -mkWriter :: (BinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s mkWriter f = BinaryWriter { putEntry = f } -mkReader :: (BinHandle -> IO s) -> BinaryReader s +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s mkReader f = BinaryReader { getEntry = f } -findUserDataReader :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryReader a +findUserDataReader :: forall a . Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a findUserDataReader query bh = case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of Nothing -> panic $ "Failed to find BinaryReader for key " ++ show (typeRep query) Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader -findUserDataWriter :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryWriter a +findUserDataWriter :: forall a . Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a findUserDataWriter query bh = case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of Nothing -> panic $ "Failed to find BinaryWriter for key " ++ show (typeRep query) @@ -1224,8 +1271,8 @@ noWriterUserData = WriterUserData { ud_writer_data = Map.empty } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) -> ReaderUserData newReadState get_name get_fs = mkReaderUserData @@ -1233,9 +1280,9 @@ newReadState get_name get_fs = , mkSomeBinaryReader $ mkReader get_fs ] -newWriteState :: (BinHandle -> Name -> IO ()) +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) + -> (WriteBinHandle -> FastString -> IO ()) -> WriterUserData newWriteState put_binding_name put_fs = mkWriterUserData @@ -1254,14 +1301,80 @@ data SomeWriterTable f = forall a . Typeable a => SomeWriterTable (f (WriterTable, BinaryWriter a)) data ReaderTable a = ReaderTable - { getTable :: BinHandle -> IO (SymbolTable a) + { getTable :: ReadBinHandle -> IO (SymbolTable a) , mkReaderFromTable :: SymbolTable a -> BinaryReader a } data WriterTable = WriterTable - { putTable :: BinHandle -> IO Int + { putTable :: WriteBinHandle -> IO Int + } + +-- ---------------------------------------------------------------------------- +-- Common data structures for constructing and maintaining lookup tables for +-- binary serialisation and deserialisation. +-- ---------------------------------------------------------------------------- + +data GenericSymbolTable a = GenericSymbolTable + { gen_symtab_next :: !FastMutInt + -- ^ The next index to use + , gen_symtab_map :: !(IORef (Map.Map a Int)) + -- ^ Given a symbol, find the symbol } +initGenericSymbolTable :: IO (GenericSymbolTable a) +initGenericSymbolTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef Map.empty + pure $ GenericSymbolTable + { gen_symtab_next = symtab_next + , gen_symtab_map = symtab_map + } + +putGenericSymbolTable :: forall a. GenericSymbolTable a -> (BinHandle -> a -> IO ()) -> BinHandle -> IO Int +putGenericSymbolTable gen_sym_tab serialiser bh = do + table_count <- readFastMutInt symtab_next + symtab_map <- readIORef symtab_map + putGenericSymbolTable bh table_count symtab_map + pure table_count + where + symtab_map = gen_symtab_map gen_sym_tab + symtab_next = gen_symtab_next gen_sym_tab + putGenericSymbolTable :: BinHandle -> Int -> Map.Map a Int -> IO () + putGenericSymbolTable bh name_count symtab = do + put_ bh name_count + let genElements = elems (array (0,name_count-1) (fmap swap $ Map.toList symtab)) + mapM_ (\n -> serialiser bh n) genElements + +getGenericSymbolTable :: forall a. (BinHandle -> IO a) -> BinHandle -> IO (SymbolTable a) +getGenericSymbolTable deserialiser bh = do + sz <- get bh :: IO Int + mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int a) + forM_ [0..(sz-1)] $ \i -> do + f <- deserialiser bh + writeArray mut_arr i f + unsafeFreeze mut_arr + +putGenericSymTab :: (Ord a, Binary a) => GenericSymbolTable a -> BinHandle -> a -> IO () +putGenericSymTab GenericSymbolTable{ + gen_symtab_map = symtab_map_ref, + gen_symtab_next = symtab_next } + bh val = do + symtab_map <- readIORef symtab_map_ref + case Map.lookup val symtab_map of + Just off -> put_ bh (fromIntegral off :: Word32) + Nothing -> do + off <- readFastMutInt symtab_next + writeFastMutInt symtab_next (off+1) + writeIORef symtab_map_ref + $! Map.insert val off symtab_map + put_ bh (fromIntegral off :: Word32) + +getGenericSymtab :: Binary a => SymbolTable a + -> BinHandle -> IO a +getGenericSymtab symtab bh = do + i :: Word32 <- get bh + return $! symtab ! fromIntegral i + --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- @@ -1299,14 +1412,14 @@ initFastStringWriterTable = do , mkWriter $ putDictFastString bin_dict ) -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1315,12 +1428,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1357,34 +1470,34 @@ type SymbolTable a = Array Int a -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit d559cde5afeb9323861428a7317a59be055b9e13 +Subproject commit 799390d1c6d59a606c3dd00dea057baa26ed0c2f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f19ba2ba0f4bcc25eceffd3531b949eedb000a0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f19ba2ba0f4bcc25eceffd3531b949eedb000a0 You're receiving 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 Apr 2 11:52:07 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 07:52:07 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` Message-ID: <660bf16719ccd_26e1f61086c6c859a3@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: 487e6f44 by Fendor at 2024-04-02T13:51:37+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 10 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -75,7 +75,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -137,7 +137,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -148,7 +148,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -156,7 +156,7 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do let -- The order of these entries matters! @@ -194,14 +194,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -211,7 +211,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -235,7 +235,7 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int, Int, b) +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) putWithTables bh' put_payload = do let -- The order of these entries matters! @@ -380,7 +380,7 @@ initWriteNameTable = do ) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -389,7 +389,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -410,7 +410,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -434,7 +434,7 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: BinSymbolTable -> BinHandle -> Name -> IO () +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } @@ -460,7 +460,7 @@ putName BinSymbolTable{ -- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name - -> BinHandle -> IO Name + -> ReadBinHandle -> IO Name getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -111,19 +111,19 @@ writeHieFile hie_file_path hiefile = do put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next symtab_map' <- readIORef symtab_map putSymbolTable bh symtab_next' symtab_map' - -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + -- write the tellBinWriter pointer at the front of the file + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -181,7 +181,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -190,7 +190,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -213,7 +213,7 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data @@ -232,21 +232,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -260,13 +260,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -276,12 +276,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable Name -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -334,7 +334,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -345,7 +345,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -37,7 +37,7 @@ computeFingerprint a = do -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -119,10 +119,10 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = case findUserDataWriter Proxy bh of tbl -> @@ -2445,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -89,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq -import Data.Proxy +import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -322,7 +322,7 @@ putObject bh mod_name deps os = do -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -330,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -345,7 +345,7 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) @@ -353,7 +353,7 @@ getObjectBody bh0 mod_name = do block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -364,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -393,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -409,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -779,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -31,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -87,7 +89,23 @@ module GHC.Utils.Binary initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, - +<<<<<<< HEAD + -- * Generic Symbol that can be used for user-defined deduplication tables. + GenericSymbolTable(..), + initGenericSymbolTable, + putGenericSymbolTable, getGenericSymbolTable, + putGenericSymTab, getGenericSymtab, +||||||| parent of f3fd018a62 (Fixup: Generic Symbol Table) + +======= + + -- * Generic Symbol that can be used for user-defined deduplication tables. + GenericSymbolTable(..), + initGenericSymbolTable, + putGenericSymbolTable, getGenericSymbolTable, + putGenericSymTab, getGenericSymtab, + +>>>>>>> f3fd018a62 (Fixup: Generic Symbol Table) -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..) ) where @@ -171,70 +189,83 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noReaderUserData noWriterUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_reader :: ReaderUserData, -- sigh, need parameterized modules :-) - bh_writer :: WriterUserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: !WriterUserData, + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) + } + +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: !ReaderUserData, + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getReaderUserData :: BinHandle -> ReaderUserData -getReaderUserData bh = bh_reader bh +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh -getWriterUserData :: BinHandle -> WriterUserData -getWriterUserData bh = bh_writer bh +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setWriterUserData :: BinHandle -> WriterUserData -> BinHandle -setWriterUserData bh us = bh { bh_writer = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } -setReaderUserData :: BinHandle -> ReaderUserData -> BinHandle -setReaderUserData bh us = bh { bh_reader = us } +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } -addReaderToUserData :: SomeBinaryReader -> BinHandle -> BinHandle +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh - { bh_reader = (bh_reader bh) - { ud_reader_data = Map.insert typRep cache (ud_reader_data (bh_reader bh)) + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) } } -addWriterToUserData :: SomeBinaryWriter -> BinHandle -> BinHandle +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh - { bh_writer = (bh_writer bh) - { ud_writer_data = Map.insert typRep cache (ud_writer_data (bh_writer bh)) + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) } } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -253,23 +284,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -277,42 +308,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) + +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -321,20 +367,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -355,7 +404,7 @@ expandBin (BinMem _ _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -371,7 +420,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -392,8 +441,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -414,39 +463,37 @@ putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -454,7 +501,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -467,7 +514,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -479,7 +526,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -500,10 +547,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -526,15 +573,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -551,15 +598,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -575,15 +622,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -603,15 +650,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -1022,63 +1069,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1086,14 +1133,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1183,31 +1230,31 @@ mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReade mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb data BinaryReader s = BinaryReader - { getEntry :: BinHandle -> IO s + { getEntry :: ReadBinHandle -> IO s } data BinaryWriter s = BinaryWriter - { putEntry :: BinHandle -> s -> IO () + { putEntry :: WriteBinHandle -> s -> IO () } -mkWriter :: (BinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s mkWriter f = BinaryWriter { putEntry = f } -mkReader :: (BinHandle -> IO s) -> BinaryReader s +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s mkReader f = BinaryReader { getEntry = f } -findUserDataReader :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryReader a +findUserDataReader :: forall a . Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a findUserDataReader query bh = case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of Nothing -> panic $ "Failed to find BinaryReader for key " ++ show (typeRep query) Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader -findUserDataWriter :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryWriter a +findUserDataWriter :: forall a . Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a findUserDataWriter query bh = case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of Nothing -> panic $ "Failed to find BinaryWriter for key " ++ show (typeRep query) @@ -1224,8 +1271,8 @@ noWriterUserData = WriterUserData { ud_writer_data = Map.empty } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) -> ReaderUserData newReadState get_name get_fs = mkReaderUserData @@ -1233,9 +1280,9 @@ newReadState get_name get_fs = , mkSomeBinaryReader $ mkReader get_fs ] -newWriteState :: (BinHandle -> Name -> IO ()) +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) + -> (WriteBinHandle -> FastString -> IO ()) -> WriterUserData newWriteState put_binding_name put_fs = mkWriterUserData @@ -1254,14 +1301,80 @@ data SomeWriterTable f = forall a . Typeable a => SomeWriterTable (f (WriterTable, BinaryWriter a)) data ReaderTable a = ReaderTable - { getTable :: BinHandle -> IO (SymbolTable a) + { getTable :: ReadBinHandle -> IO (SymbolTable a) , mkReaderFromTable :: SymbolTable a -> BinaryReader a } data WriterTable = WriterTable - { putTable :: BinHandle -> IO Int + { putTable :: WriteBinHandle -> IO Int + } + +-- ---------------------------------------------------------------------------- +-- Common data structures for constructing and maintaining lookup tables for +-- binary serialisation and deserialisation. +-- ---------------------------------------------------------------------------- + +data GenericSymbolTable a = GenericSymbolTable + { gen_symtab_next :: !FastMutInt + -- ^ The next index to use + , gen_symtab_map :: !(IORef (Map.Map a Int)) + -- ^ Given a symbol, find the symbol } +initGenericSymbolTable :: IO (GenericSymbolTable a) +initGenericSymbolTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef Map.empty + pure $ GenericSymbolTable + { gen_symtab_next = symtab_next + , gen_symtab_map = symtab_map + } + +putGenericSymbolTable :: forall a. GenericSymbolTable a -> (BinHandle -> a -> IO ()) -> BinHandle -> IO Int +putGenericSymbolTable gen_sym_tab serialiser bh = do + table_count <- readFastMutInt symtab_next + symtab_map <- readIORef symtab_map + putGenericSymbolTable bh table_count symtab_map + pure table_count + where + symtab_map = gen_symtab_map gen_sym_tab + symtab_next = gen_symtab_next gen_sym_tab + putGenericSymbolTable :: BinHandle -> Int -> Map.Map a Int -> IO () + putGenericSymbolTable bh name_count symtab = do + put_ bh name_count + let genElements = elems (array (0,name_count-1) (fmap swap $ Map.toList symtab)) + mapM_ (\n -> serialiser bh n) genElements + +getGenericSymbolTable :: forall a. (BinHandle -> IO a) -> BinHandle -> IO (SymbolTable a) +getGenericSymbolTable deserialiser bh = do + sz <- get bh :: IO Int + mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int a) + forM_ [0..(sz-1)] $ \i -> do + f <- deserialiser bh + writeArray mut_arr i f + unsafeFreeze mut_arr + +putGenericSymTab :: (Ord a, Binary a) => GenericSymbolTable a -> BinHandle -> a -> IO () +putGenericSymTab GenericSymbolTable{ + gen_symtab_map = symtab_map_ref, + gen_symtab_next = symtab_next } + bh val = do + symtab_map <- readIORef symtab_map_ref + case Map.lookup val symtab_map of + Just off -> put_ bh (fromIntegral off :: Word32) + Nothing -> do + off <- readFastMutInt symtab_next + writeFastMutInt symtab_next (off+1) + writeIORef symtab_map_ref + $! Map.insert val off symtab_map + put_ bh (fromIntegral off :: Word32) + +getGenericSymtab :: Binary a => SymbolTable a + -> BinHandle -> IO a +getGenericSymtab symtab bh = do + i :: Word32 <- get bh + return $! symtab ! fromIntegral i + --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- @@ -1299,14 +1412,14 @@ initFastStringWriterTable = do , mkWriter $ putDictFastString bin_dict ) -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1315,12 +1428,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1357,34 +1470,34 @@ type SymbolTable a = Array Int a -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit d559cde5afeb9323861428a7317a59be055b9e13 +Subproject commit 799390d1c6d59a606c3dd00dea057baa26ed0c2f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/487e6f44be930b4536481c202b5af1d11a8ff185 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/487e6f44be930b4536481c202b5af1d11a8ff185 You're receiving 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 Apr 2 11:57:18 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 07:57:18 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` Message-ID: <660bf29df2da7_26e1f611b5278871f0@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: 2c19bd36 by Fendor at 2024-04-02T13:56:56+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 10 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -75,7 +75,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -137,7 +137,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -148,7 +148,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -156,7 +156,7 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do let -- The order of these entries matters! @@ -194,14 +194,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -211,7 +211,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -235,7 +235,7 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int, Int, b) +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) putWithTables bh' put_payload = do let -- The order of these entries matters! @@ -380,7 +380,7 @@ initWriteNameTable = do ) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -389,7 +389,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -410,7 +410,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -434,7 +434,7 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: BinSymbolTable -> BinHandle -> Name -> IO () +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } @@ -460,7 +460,7 @@ putName BinSymbolTable{ -- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name - -> BinHandle -> IO Name + -> ReadBinHandle -> IO Name getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -111,9 +111,9 @@ writeHieFile hie_file_path hiefile = do put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next @@ -121,9 +121,9 @@ writeHieFile hie_file_path hiefile = do putSymbolTable bh symtab_next' symtab_map' -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -181,7 +181,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -190,7 +190,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -213,7 +213,7 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data @@ -232,21 +232,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -260,13 +260,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -276,12 +276,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable Name -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -334,7 +334,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -345,7 +345,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -37,7 +37,7 @@ computeFingerprint a = do -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -119,10 +119,10 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = case findUserDataWriter Proxy bh of tbl -> @@ -2445,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -89,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq -import Data.Proxy +import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -322,7 +322,7 @@ putObject bh mod_name deps os = do -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -330,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -345,7 +345,7 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) @@ -353,7 +353,7 @@ getObjectBody bh0 mod_name = do block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -364,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -393,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -409,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -779,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -31,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -87,7 +89,23 @@ module GHC.Utils.Binary initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, - +<<<<<<< HEAD + -- * Generic Symbol that can be used for user-defined deduplication tables. + GenericSymbolTable(..), + initGenericSymbolTable, + putGenericSymbolTable, getGenericSymbolTable, + putGenericSymTab, getGenericSymtab, +||||||| parent of f3fd018a62 (Fixup: Generic Symbol Table) + +======= + + -- * Generic Symbol that can be used for user-defined deduplication tables. + GenericSymbolTable(..), + initGenericSymbolTable, + putGenericSymbolTable, getGenericSymbolTable, + putGenericSymTab, getGenericSymtab, + +>>>>>>> f3fd018a62 (Fixup: Generic Symbol Table) -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..) ) where @@ -171,70 +189,83 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noReaderUserData noWriterUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_reader :: ReaderUserData, -- sigh, need parameterized modules :-) - bh_writer :: WriterUserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: !WriterUserData, + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) + } + +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: !ReaderUserData, + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getReaderUserData :: BinHandle -> ReaderUserData -getReaderUserData bh = bh_reader bh +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh -getWriterUserData :: BinHandle -> WriterUserData -getWriterUserData bh = bh_writer bh +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setWriterUserData :: BinHandle -> WriterUserData -> BinHandle -setWriterUserData bh us = bh { bh_writer = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } -setReaderUserData :: BinHandle -> ReaderUserData -> BinHandle -setReaderUserData bh us = bh { bh_reader = us } +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } -addReaderToUserData :: SomeBinaryReader -> BinHandle -> BinHandle +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh - { bh_reader = (bh_reader bh) - { ud_reader_data = Map.insert typRep cache (ud_reader_data (bh_reader bh)) + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) } } -addWriterToUserData :: SomeBinaryWriter -> BinHandle -> BinHandle +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh - { bh_writer = (bh_writer bh) - { ud_writer_data = Map.insert typRep cache (ud_writer_data (bh_writer bh)) + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) } } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -253,23 +284,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -277,42 +308,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) + +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -321,20 +367,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -355,7 +404,7 @@ expandBin (BinMem _ _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -371,7 +420,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -392,8 +441,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -414,39 +463,37 @@ putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -454,7 +501,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -467,7 +514,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -479,7 +526,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -500,10 +547,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -526,15 +573,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -551,15 +598,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -575,15 +622,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -603,15 +650,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -1022,63 +1069,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1086,14 +1133,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1183,31 +1230,31 @@ mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReade mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb data BinaryReader s = BinaryReader - { getEntry :: BinHandle -> IO s + { getEntry :: ReadBinHandle -> IO s } data BinaryWriter s = BinaryWriter - { putEntry :: BinHandle -> s -> IO () + { putEntry :: WriteBinHandle -> s -> IO () } -mkWriter :: (BinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s mkWriter f = BinaryWriter { putEntry = f } -mkReader :: (BinHandle -> IO s) -> BinaryReader s +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s mkReader f = BinaryReader { getEntry = f } -findUserDataReader :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryReader a +findUserDataReader :: forall a . Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a findUserDataReader query bh = case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of Nothing -> panic $ "Failed to find BinaryReader for key " ++ show (typeRep query) Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader -findUserDataWriter :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryWriter a +findUserDataWriter :: forall a . Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a findUserDataWriter query bh = case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of Nothing -> panic $ "Failed to find BinaryWriter for key " ++ show (typeRep query) @@ -1224,8 +1271,8 @@ noWriterUserData = WriterUserData { ud_writer_data = Map.empty } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) -> ReaderUserData newReadState get_name get_fs = mkReaderUserData @@ -1233,9 +1280,9 @@ newReadState get_name get_fs = , mkSomeBinaryReader $ mkReader get_fs ] -newWriteState :: (BinHandle -> Name -> IO ()) +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) + -> (WriteBinHandle -> FastString -> IO ()) -> WriterUserData newWriteState put_binding_name put_fs = mkWriterUserData @@ -1254,14 +1301,80 @@ data SomeWriterTable f = forall a . Typeable a => SomeWriterTable (f (WriterTable, BinaryWriter a)) data ReaderTable a = ReaderTable - { getTable :: BinHandle -> IO (SymbolTable a) + { getTable :: ReadBinHandle -> IO (SymbolTable a) , mkReaderFromTable :: SymbolTable a -> BinaryReader a } data WriterTable = WriterTable - { putTable :: BinHandle -> IO Int + { putTable :: WriteBinHandle -> IO Int + } + +-- ---------------------------------------------------------------------------- +-- Common data structures for constructing and maintaining lookup tables for +-- binary serialisation and deserialisation. +-- ---------------------------------------------------------------------------- + +data GenericSymbolTable a = GenericSymbolTable + { gen_symtab_next :: !FastMutInt + -- ^ The next index to use + , gen_symtab_map :: !(IORef (Map.Map a Int)) + -- ^ Given a symbol, find the symbol } +initGenericSymbolTable :: IO (GenericSymbolTable a) +initGenericSymbolTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef Map.empty + pure $ GenericSymbolTable + { gen_symtab_next = symtab_next + , gen_symtab_map = symtab_map + } + +putGenericSymbolTable :: forall a. GenericSymbolTable a -> (BinHandle -> a -> IO ()) -> BinHandle -> IO Int +putGenericSymbolTable gen_sym_tab serialiser bh = do + table_count <- readFastMutInt symtab_next + symtab_map <- readIORef symtab_map + putGenericSymbolTable bh table_count symtab_map + pure table_count + where + symtab_map = gen_symtab_map gen_sym_tab + symtab_next = gen_symtab_next gen_sym_tab + putGenericSymbolTable :: BinHandle -> Int -> Map.Map a Int -> IO () + putGenericSymbolTable bh name_count symtab = do + put_ bh name_count + let genElements = elems (array (0,name_count-1) (fmap swap $ Map.toList symtab)) + mapM_ (\n -> serialiser bh n) genElements + +getGenericSymbolTable :: forall a. (BinHandle -> IO a) -> BinHandle -> IO (SymbolTable a) +getGenericSymbolTable deserialiser bh = do + sz <- get bh :: IO Int + mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int a) + forM_ [0..(sz-1)] $ \i -> do + f <- deserialiser bh + writeArray mut_arr i f + unsafeFreeze mut_arr + +putGenericSymTab :: (Ord a, Binary a) => GenericSymbolTable a -> BinHandle -> a -> IO () +putGenericSymTab GenericSymbolTable{ + gen_symtab_map = symtab_map_ref, + gen_symtab_next = symtab_next } + bh val = do + symtab_map <- readIORef symtab_map_ref + case Map.lookup val symtab_map of + Just off -> put_ bh (fromIntegral off :: Word32) + Nothing -> do + off <- readFastMutInt symtab_next + writeFastMutInt symtab_next (off+1) + writeIORef symtab_map_ref + $! Map.insert val off symtab_map + put_ bh (fromIntegral off :: Word32) + +getGenericSymtab :: Binary a => SymbolTable a + -> BinHandle -> IO a +getGenericSymtab symtab bh = do + i :: Word32 <- get bh + return $! symtab ! fromIntegral i + --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- @@ -1299,14 +1412,14 @@ initFastStringWriterTable = do , mkWriter $ putDictFastString bin_dict ) -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1315,12 +1428,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1357,34 +1470,34 @@ type SymbolTable a = Array Int a -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit d559cde5afeb9323861428a7317a59be055b9e13 +Subproject commit 799390d1c6d59a606c3dd00dea057baa26ed0c2f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c19bd36e0124194f641ef74a11aee0736125fa7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c19bd36e0124194f641ef74a11aee0736125fa7 You're receiving 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 Apr 2 11:59:10 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 07:59:10 -0400 Subject: [Git][ghc/ghc][wip/fendor/os-string-modlocation] Migrate `Finder` component to `OsPath` Message-ID: <660bf30e1b84d_26e1f6129646c8839a@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/os-string-modlocation at Glasgow Haskell Compiler / GHC Commits: e67e4a42 by Fendor at 2024-04-02T13:58:52+02:00 Migrate `Finder` component to `OsPath` For each module in a GHCi session, we keep alive one `ModLocation`. A `ModLocation` is fairly inefficiently packed, as `String`s are expensive in memory usage. While benchmarking the agda codebase, we concluded that we keep alive around 11MB of `FilePath`'s, solely retained by `ModLocation`. We provide a more densely packed encoding of `ModLocation`, by moving from `FilePath` to `OsPath`. Further, we migrate the full `Finder` component to `OsPath` to avoid unnecessary transformations. As the `Finder` component is well-encapsuled, this requires only a minimal amount of changes in other modules. Bump to haddock submodule for `ModLocation` changes. - - - - - 17 changed files: - compiler/GHC.hs - + compiler/GHC/Data/OsPath.hs - compiler/GHC/Data/Strict.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Location.hs - compiler/ghc.cabal.in - utils/haddock Changes: ===================================== compiler/GHC.hs ===================================== @@ -76,6 +76,12 @@ module GHC ( ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries, mgLookupModule, ModSummary(..), ms_mod_name, ModLocation(..), + ml_hs_file, + ml_hi_file, + ml_dyn_hi_file, + ml_obj_file, + ml_dyn_obj_file, + ml_hie_file, getModSummary, getModuleGraph, isLoaded, ===================================== compiler/GHC/Data/OsPath.hs ===================================== @@ -0,0 +1,19 @@ +module GHC.Data.OsPath + ( + -- * OsPath initialisation and transformation + OsPath + , unsafeDecodeUtf + , unsafeEncodeUtf + -- * Common utility functions + , () + , (<.>) + ) + where + +import GHC.Prelude + +import System.OsPath +import Data.Either + +unsafeDecodeUtf :: OsPath -> FilePath +unsafeDecodeUtf = fromRight (error "unsafeEncodeUtf: Internal error") . decodeUtf ===================================== compiler/GHC/Data/Strict.hs ===================================== @@ -9,8 +9,11 @@ module GHC.Data.Strict ( Maybe(Nothing, Just), fromMaybe, + GHC.Data.Strict.maybe, Pair(And), - + expectJust, + fromLazy, + toLazy, -- Not used at the moment: -- -- Either(Left, Right), @@ -18,9 +21,12 @@ module GHC.Data.Strict ( ) where import GHC.Prelude hiding (Maybe(..), Either(..)) +import GHC.Stack.Types + import Control.Applicative import Data.Semigroup import Data.Data +import qualified Data.Maybe as Lazy data Maybe a = Nothing | Just !a deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data) @@ -29,6 +35,10 @@ fromMaybe :: a -> Maybe a -> a fromMaybe d Nothing = d fromMaybe _ (Just x) = x +maybe :: b -> (a -> b) -> Maybe a -> b +maybe d _ Nothing = d +maybe _ f (Just x) = f x + apMaybe :: Maybe (a -> b) -> Maybe a -> Maybe b apMaybe (Just f) (Just x) = Just (f x) apMaybe _ _ = Nothing @@ -37,6 +47,19 @@ altMaybe :: Maybe a -> Maybe a -> Maybe a altMaybe Nothing r = r altMaybe l _ = l +fromLazy :: Lazy.Maybe a -> Maybe a +fromLazy (Lazy.Just a) = Just a +fromLazy Lazy.Nothing = Nothing + +toLazy :: Maybe a -> Lazy.Maybe a +toLazy (Just a) = Lazy.Just a +toLazy Nothing = Lazy.Nothing + +expectJust :: HasCallStack => String -> Maybe a -> a +{-# INLINE expectJust #-} +expectJust _ (Just x) = x +expectJust err Nothing = error ("expectJust " ++ err) + instance Semigroup a => Semigroup (Maybe a) where Nothing <> b = b a <> Nothing = a ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -74,6 +74,7 @@ import GHC.Linker.Types import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Maybe +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Data.StringBuffer import GHC.Data.FastString import qualified GHC.Data.EnumSet as EnumSet @@ -772,7 +773,7 @@ summariseRequirement pn mod_name = do let PackageName pn_fs = pn let location = mkHomeModLocation2 fopts mod_name - (unpackFS pn_fs moduleNameSlashes mod_name) "hsig" + (unsafeEncodeUtf $ unpackFS pn_fs moduleNameSlashes mod_name) (unsafeEncodeUtf "hsig") env <- getBkpEnv src_hash <- liftIO $ getFileHash (bkp_filename env) @@ -855,12 +856,12 @@ hsModuleToModSummary home_keys pn hsc_src modname -- these filenames to figure out where the hi files go. -- A travesty! let location0 = mkHomeModLocation2 fopts modname - (unpackFS unit_fs + (unsafeEncodeUtf $ unpackFS unit_fs moduleNameSlashes modname) (case hsc_src of - HsigFile -> "hsig" - HsBootFile -> "hs-boot" - HsSrcFile -> "hs") + HsigFile -> unsafeEncodeUtf "hsig" + HsBootFile -> unsafeEncodeUtf "hs-boot" + HsSrcFile -> unsafeEncodeUtf "hs") -- DANGEROUS: bootifying can POISON the module finder cache let location = case hsc_src of HsBootFile -> addBootSuffixLocnOut location0 ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Driver.Ppr import GHC.Driver.Backend +import GHC.Data.OsPath import qualified GHC.Data.ShortText as ST import GHC.Data.Stream ( Stream ) import qualified GHC.Data.Stream as Stream @@ -259,7 +260,7 @@ outputForeignStubs Maybe FilePath) -- C file created outputForeignStubs logger tmpfs dflags unit_state mod location stubs = do - let stub_h = mkStubPaths (initFinderOpts dflags) (moduleName mod) location + let stub_h = unsafeDecodeUtf $ mkStubPaths (initFinderOpts dflags) (moduleName mod) location stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" case stubs of ===================================== compiler/GHC/Driver/Config/Finder.hs ===================================== @@ -5,30 +5,31 @@ module GHC.Driver.Config.Finder ( import GHC.Prelude +import qualified GHC.Data.Strict as Strict import GHC.Driver.DynFlags import GHC.Unit.Finder.Types import GHC.Data.FastString - +import GHC.Data.OsPath -- | Create a new 'FinderOpts' from DynFlags. initFinderOpts :: DynFlags -> FinderOpts initFinderOpts flags = FinderOpts - { finder_importPaths = importPaths flags + { finder_importPaths = fmap unsafeEncodeUtf $ importPaths flags , finder_lookupHomeInterfaces = isOneShot (ghcMode flags) , finder_bypassHiFileCheck = MkDepend == (ghcMode flags) , finder_ways = ways flags , finder_enableSuggestions = gopt Opt_HelpfulErrors flags - , finder_workingDirectory = workingDirectory flags + , finder_workingDirectory = fmap unsafeEncodeUtf $ Strict.fromLazy $ workingDirectory flags , finder_thisPackageName = mkFastString <$> thisPackageName flags , finder_hiddenModules = hiddenModules flags , finder_reexportedModules = reexportedModules flags - , finder_hieDir = hieDir flags - , finder_hieSuf = hieSuf flags - , finder_hiDir = hiDir flags - , finder_hiSuf = hiSuf_ flags - , finder_dynHiSuf = dynHiSuf_ flags - , finder_objectDir = objectDir flags - , finder_objectSuf = objectSuf_ flags - , finder_dynObjectSuf = dynObjectSuf_ flags - , finder_stubDir = stubDir flags + , finder_hieDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hieDir flags + , finder_hieSuf = unsafeEncodeUtf $ hieSuf flags + , finder_hiDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hiDir flags + , finder_hiSuf = unsafeEncodeUtf $ hiSuf_ flags + , finder_dynHiSuf = unsafeEncodeUtf $ dynHiSuf_ flags + , finder_objectDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ objectDir flags + , finder_objectSuf = unsafeEncodeUtf $ objectSuf_ flags + , finder_dynObjectSuf = unsafeEncodeUtf $ dynObjectSuf_ flags + , finder_stubDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ stubDir flags } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -264,6 +264,8 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString import GHC.Data.Bag +import GHC.Data.OsPath (unsafeEncodeUtf) +import qualified GHC.Data.Strict as Strict import GHC.Data.StringBuffer import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) @@ -2106,12 +2108,12 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs rawCmms return stub_c_exists where - no_loc = ModLocation{ ml_hs_file = Just original_filename, - ml_hi_file = panic "hscCompileCmmFile: no hi file", - ml_obj_file = panic "hscCompileCmmFile: no obj file", - ml_dyn_obj_file = panic "hscCompileCmmFile: no dyn obj file", - ml_dyn_hi_file = panic "hscCompileCmmFile: no dyn obj file", - ml_hie_file = panic "hscCompileCmmFile: no hie file"} + no_loc = ModLocation{ ml_hs_file_ = Strict.Just $ unsafeEncodeUtf original_filename, + ml_hi_file_ = panic "hscCompileCmmFile: no hi file", + ml_obj_file_ = panic "hscCompileCmmFile: no obj file", + ml_dyn_obj_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_dyn_hi_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_hie_file_ = panic "hscCompileCmmFile: no hie file"} -------------------- Stuff for new code gen --------------------- @@ -2346,12 +2348,12 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do {- Desugar it -} -- We use a basically null location for iNTERACTIVE - let iNTERACTIVELoc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hsDeclsWithLocation:ml_hi_file", - ml_obj_file = panic "hsDeclsWithLocation:ml_obj_file", - ml_dyn_obj_file = panic "hsDeclsWithLocation:ml_dyn_obj_file", - ml_dyn_hi_file = panic "hsDeclsWithLocation:ml_dyn_hi_file", - ml_hie_file = panic "hsDeclsWithLocation:ml_hie_file" } + let iNTERACTIVELoc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hsDeclsWithLocation:ml_hi_file", + ml_obj_file_ = panic "hsDeclsWithLocation:ml_obj_file", + ml_dyn_obj_file_ = panic "hsDeclsWithLocation:ml_dyn_obj_file", + ml_dyn_hi_file_ = panic "hsDeclsWithLocation:ml_dyn_hi_file", + ml_hie_file_ = panic "hsDeclsWithLocation:ml_hie_file" } ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv {- Simplify -} @@ -2630,12 +2632,12 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- Lint if necessary -} lintInteractiveExpr (text "hscCompileCoreExpr") hsc_env prepd_expr - let this_loc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file", - ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file", - ml_dyn_obj_file = panic "hscCompileCoreExpr': ml_obj_file", - ml_dyn_hi_file = panic "hscCompileCoreExpr': ml_dyn_hi_file", - ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } + let this_loc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hscCompileCoreExpr':ml_hi_file", + ml_obj_file_ = panic "hscCompileCoreExpr':ml_obj_file", + ml_dyn_obj_file_ = panic "hscCompileCoreExpr': ml_obj_file", + ml_dyn_hi_file_ = panic "hscCompileCoreExpr': ml_dyn_hi_file", + ml_hie_file_ = panic "hscCompileCoreExpr':ml_hie_file" } -- Ensure module uniqueness by giving it a name like "GhciNNNN". -- This uniqueness is needed by the JS linker. Without it we break the 1-1 ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -72,10 +72,12 @@ import GHC.Iface.Load ( cannotFindModule ) import GHC.IfaceToCore ( typecheckIface ) import GHC.Iface.Recomp ( RecompileRequired(..), CompileReason(..) ) +import qualified GHC.Data.Strict as Strict import GHC.Data.Bag ( listToBag ) import GHC.Data.Graph.Directed import GHC.Data.FastString import GHC.Data.Maybe ( expectJust ) +import GHC.Data.OsPath ( unsafeEncodeUtf, unsafeDecodeUtf ) import GHC.Data.StringBuffer import qualified GHC.LanguageExtensions as LangExt @@ -336,12 +338,15 @@ warnMissingHomeModules dflags targets mod_graph = -> moduleName (ms_mod mod) == name && tuid == ms_unitid mod TargetFile target_file _ - | Just mod_file <- ml_hs_file (ms_location mod) + | Strict.Just mod_file <- ml_hs_file_ (ms_location mod) -> - augmentByWorkingDirectory dflags target_file == mod_file || + let + target_os_file = unsafeEncodeUtf target_file + in + augmentByWorkingDirectory dflags target_file == unsafeDecodeUtf mod_file || -- Don't warn on B.hs-boot if B.hs is specified (#16551) - addBootSuffix target_file == mod_file || + addBootSuffix target_os_file == mod_file || -- We can get a file target even if a module name was -- originally specified in a command line because it can @@ -1830,7 +1835,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf let dyn_tn = tn -<.> dynsuf addFilesToClean tmpfs dynLife [dyn_tn] - return (tn, dyn_tn) + return (unsafeEncodeUtf tn, unsafeEncodeUtf dyn_tn) -- We don't want to create .o or .hi files unless we have been asked -- to by the user. But we need them, so we patch their locations in -- the ModSummary with temporary files. @@ -1839,8 +1844,8 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- If ``-fwrite-interface` is specified, then the .o and .hi files -- are written into `-odir` and `-hidir` respectively. #16670 if gopt Opt_WriteInterface dflags - then return ((ml_hi_file ms_location, ml_dyn_hi_file ms_location) - , (ml_obj_file ms_location, ml_dyn_obj_file ms_location)) + then return ((ml_hi_file_ ms_location, ml_dyn_hi_file_ ms_location) + , (ml_obj_file_ ms_location, ml_dyn_obj_file_ ms_location)) else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) let new_dflags = case enable_spec of @@ -1849,10 +1854,10 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} let ms' = ms { ms_location = - ms_location { ml_hi_file = hi_file - , ml_obj_file = o_file - , ml_dyn_hi_file = dyn_hi_file - , ml_dyn_obj_file = dyn_o_file } + ms_location { ml_hi_file_ = hi_file + , ml_obj_file_ = o_file + , ml_dyn_hi_file_ = dyn_hi_file + , ml_dyn_obj_file_ = dyn_o_file } , ms_hspp_opts = updOptLevel 0 $ new_dflags } -- Recursive call to catch the other cases @@ -2037,7 +2042,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf let fopts = initFinderOpts (hsc_dflags hsc_env) -- Make a ModLocation for this file - let location = mkHomeModLocation fopts pi_mod_name src_fn + let location = mkHomeModLocation fopts pi_mod_name (unsafeEncodeUtf src_fn) -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Driver.Env import GHC.Driver.Errors.Types import qualified GHC.SysTools as SysTools import GHC.Data.Graph.Directed ( SCC(..) ) +import GHC.Data.OsPath (unsafeDecodeUtf) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SourceError @@ -297,7 +298,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do Found loc _ -- Home package: just depend on the .hi or hi-boot file | isJust (ml_hs_file loc) || include_pkg_deps - -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc))) + -> return (Just (unsafeDecodeUtf $ addBootSuffix_maybe is_boot (ml_hi_file_ loc))) -- Not in this package: we don't need a dependency | otherwise ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -58,6 +58,7 @@ import GHC.Iface.Make import GHC.Driver.Config.Parser import GHC.Parser.Header import GHC.Data.StringBuffer +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Types.SourceError import GHC.Unit.Finder import Data.IORef @@ -759,7 +760,7 @@ mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO Mod mkOneShotModLocation pipe_env dflags src_flavour mod_name = do let PipeEnv{ src_basename=basename, src_suffix=suff } = pipe_env - let location1 = mkHomeModLocation2 fopts mod_name basename suff + let location1 = mkHomeModLocation2 fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff) -- Boot-ify it if necessary let location2 @@ -771,11 +772,11 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do -- This can't be done in mkHomeModuleLocation because -- it only applies to the module being compiles let ohi = outputHi dflags - location3 | Just fn <- ohi = location2{ ml_hi_file = fn } + location3 | Just fn <- ohi = location2{ ml_hi_file_ = unsafeEncodeUtf fn } | otherwise = location2 let dynohi = dynOutputHi dflags - location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file = fn } + location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file_ = unsafeEncodeUtf fn } | otherwise = location3 -- Take -o into account if present @@ -789,10 +790,10 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do location5 | Just ofile <- expl_o_file , let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file , isNoLink (ghcLink dflags) - = location4 { ml_obj_file = ofile - , ml_dyn_obj_file = dyn_ofile } + = location4 { ml_obj_file_ = unsafeEncodeUtf ofile + , ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | Just dyn_ofile <- expl_dyn_o_file - = location4 { ml_dyn_obj_file = dyn_ofile } + = location4 { ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | otherwise = location4 return location5 where ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Utils.Panic.Plain import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Data.Maybe +import GHC.Data.OsPath import GHC.Prelude import GHC.Unit import GHC.Unit.Env @@ -55,13 +56,13 @@ cantFindInstalledErr unit_state mhome_unit profile mod_name find_result InstalledNotFound files mb_pkg | Just pkg <- mb_pkg , notHomeUnitId mhome_unit pkg - -> not_found_in_package pkg files + -> not_found_in_package pkg $ fmap unsafeDecodeUtf files | null files -> NotAModule | otherwise - -> CouldntFindInFiles files + -> CouldntFindInFiles $ fmap unsafeDecodeUtf files _ -> panic "cantFindInstalledErr" ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -300,7 +300,7 @@ mkIface_ hsc_env trust_info = setSafeMode safe_mode annotations = map mkIfaceAnnotation anns icomplete_matches = map mkIfaceCompleteMatch complete_matches - !rdrs = maybeGlobalRdrEnv rdr_env + _ = maybeGlobalRdrEnv rdr_env ModIface { mi_module = this_mod, @@ -323,7 +323,7 @@ mkIface_ hsc_env mi_fixities = fixities, mi_warns = warns, mi_anns = annotations, - mi_globals = rdrs, + mi_globals = Nothing, mi_used_th = used_th, mi_decls = decls, mi_extra_decls = extra_decls, ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -42,6 +42,9 @@ import GHC.Platform.Ways import GHC.Builtin.Names ( gHC_PRIM ) +import qualified GHC.Data.Strict as Strict +import GHC.Data.OsPath + import GHC.Unit.Env import GHC.Unit.Types import GHC.Unit.Module @@ -49,7 +52,6 @@ import GHC.Unit.Home import GHC.Unit.State import GHC.Unit.Finder.Types -import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.ShortText as ST import GHC.Utils.Misc @@ -61,8 +63,7 @@ import GHC.Types.PkgQual import GHC.Fingerprint import Data.IORef -import System.Directory -import System.FilePath +import System.Directory.OsPath import Control.Monad import Data.Time import qualified Data.Map as M @@ -70,9 +71,10 @@ import GHC.Driver.Env ( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env) ) import GHC.Driver.Config.Finder import qualified Data.Set as Set +import qualified System.OsPath as OsPath -type FileExt = String -- Filename extension -type BaseName = String -- Basename of file +type FileExt = OsPath -- Filename extension +type BaseName = OsPath -- Basename of file -- ----------------------------------------------------------------------------- -- The Finder @@ -286,7 +288,7 @@ findLookupResult fc fopts r = case r of -- implicit locations from the instances InstalledFound loc _ -> return (Found loc m) InstalledNoPackage _ -> return (NoPackage (moduleUnit m)) - InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m) + InstalledNotFound fp _ -> return (NotFound{ fr_paths = fmap unsafeDecodeUtf fp, fr_pkg = Just (moduleUnit m) , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_unusables = [] @@ -357,7 +359,7 @@ findHomeModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -382,7 +384,7 @@ findHomePackageModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkModule uid mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -413,22 +415,22 @@ findInstalledHomeModule fc fopts home_unit mod_name = do let maybe_working_dir = finder_workingDirectory fopts home_path = case maybe_working_dir of - Nothing -> finder_importPaths fopts - Just fp -> augmentImports fp (finder_importPaths fopts) + Strict.Nothing -> finder_importPaths fopts + Strict.Just fp -> augmentImports fp (finder_importPaths fopts) hi_dir_path = case finder_hiDir fopts of - Just hiDir -> case maybe_working_dir of - Nothing -> [hiDir] - Just fp -> [fp hiDir] - Nothing -> home_path + Strict.Just hiDir -> case maybe_working_dir of + Strict.Nothing -> [hiDir] + Strict.Just fp -> [fp hiDir] + Strict.Nothing -> home_path hisuf = finder_hiSuf fopts mod = mkModule home_unit mod_name source_exts = - [ ("hs", mkHomeModLocationSearched fopts mod_name "hs") - , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs") - , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig") - , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig") + [ (unsafeEncodeUtf "hs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hs") + , (unsafeEncodeUtf "lhs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhs") + , (unsafeEncodeUtf "hsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hsig") + , (unsafeEncodeUtf "lhsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhsig") ] -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that @@ -453,9 +455,9 @@ findInstalledHomeModule fc fopts home_unit mod_name = do else searchPathExts search_dirs mod exts -- | Prepend the working directory to the search path. -augmentImports :: FilePath -> [FilePath] -> [FilePath] +augmentImports :: OsPath -> [OsPath] -> [OsPath] augmentImports _work_dir [] = [] -augmentImports work_dir (fp:fps) | isAbsolute fp = fp : augmentImports work_dir fps +augmentImports work_dir (fp:fps) | OsPath.isAbsolute fp = fp : augmentImports work_dir fps | otherwise = (work_dir fp) : augmentImports work_dir fps -- | Search for a module in external packages only. @@ -488,14 +490,14 @@ findPackageModule_ fc fopts mod pkg_conf = do tag = waysBuildTag (finder_ways fopts) -- hi-suffix for packages depends on the build tag. - package_hisuf | null tag = "hi" - | otherwise = tag ++ "_hi" + package_hisuf | null tag = unsafeEncodeUtf $ "hi" + | otherwise = unsafeEncodeUtf $ tag ++ "_hi" - package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" + package_dynhisuf = unsafeEncodeUtf $ waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf package_dynhisuf - import_dirs = map ST.unpack $ unitImportDirs pkg_conf + import_dirs = map (unsafeEncodeUtf . ST.unpack) $ unitImportDirs pkg_conf -- we never look for a .hi-boot file in an external package; -- .hi-boot files only make sense for the home package. in @@ -503,7 +505,7 @@ findPackageModule_ fc fopts mod pkg_conf = do [one] | finder_bypassHiFileCheck fopts -> -- there's only one place that this .hi file can be, so -- don't bother looking for it. - let basename = moduleNameSlashes (moduleName mod) + let basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) loc = mk_hi_loc one basename in return $ InstalledFound loc mod _otherwise -> @@ -512,24 +514,24 @@ findPackageModule_ fc fopts mod pkg_conf = do -- ----------------------------------------------------------------------------- -- General path searching -searchPathExts :: [FilePath] -- paths to search +searchPathExts :: [OsPath] -- paths to search -> InstalledModule -- module name -> [ ( FileExt, -- suffix - FilePath -> BaseName -> ModLocation -- action + OsPath -> BaseName -> ModLocation -- action ) ] -> IO InstalledFindResult searchPathExts paths mod exts = search to_search where - basename = moduleNameSlashes (moduleName mod) + basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) - to_search :: [(FilePath, ModLocation)] + to_search :: [(OsPath, ModLocation)] to_search = [ (file, fn path basename) | path <- paths, (ext,fn) <- exts, - let base | path == "." = basename + let base | path == unsafeEncodeUtf "." = basename | otherwise = path basename file = base <.> ext ] @@ -543,7 +545,7 @@ searchPathExts paths mod exts = search to_search else search rest mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt - -> FilePath -> BaseName -> ModLocation + -> OsPath -> BaseName -> ModLocation mkHomeModLocationSearched fopts mod suff path basename = mkHomeModLocation2 fopts mod (path basename) suff @@ -581,18 +583,18 @@ mkHomeModLocationSearched fopts mod suff path basename = -- ext -- The filename extension of the source file (usually "hs" or "lhs"). -mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation +mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> ModLocation mkHomeModLocation dflags mod src_filename = - let (basename,extension) = splitExtension src_filename + let (basename,extension) = OsPath.splitExtension src_filename in mkHomeModLocation2 dflags mod basename extension mkHomeModLocation2 :: FinderOpts -> ModuleName - -> FilePath -- Of source module, without suffix - -> String -- Suffix + -> OsPath -- Of source module, without suffix + -> OsPath -- Suffix -> ModLocation mkHomeModLocation2 fopts mod src_basename ext = - let mod_basename = moduleNameSlashes mod + let mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod obj_fn = mkObjPath fopts src_basename mod_basename dyn_obj_fn = mkDynObjPath fopts src_basename mod_basename @@ -600,72 +602,72 @@ mkHomeModLocation2 fopts mod src_basename ext = dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename hie_fn = mkHiePath fopts src_basename mod_basename - in (ModLocation{ ml_hs_file = Just (src_basename <.> ext), - ml_hi_file = hi_fn, - ml_dyn_hi_file = dyn_hi_fn, - ml_obj_file = obj_fn, - ml_dyn_obj_file = dyn_obj_fn, - ml_hie_file = hie_fn }) + in (ModLocation{ ml_hs_file_ = Strict.Just (src_basename <.> ext), + ml_hi_file_ = hi_fn, + ml_dyn_hi_file_ = dyn_hi_fn, + ml_obj_file_ = obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, + ml_hie_file_ = hie_fn }) mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName - -> FilePath + -> OsPath -> BaseName -> ModLocation mkHomeModHiOnlyLocation fopts mod path basename = - let loc = mkHomeModLocation2 fopts mod (path basename) "" - in loc { ml_hs_file = Nothing } + let loc = mkHomeModLocation2 fopts mod (path basename) mempty + in loc { ml_hs_file_ = Strict.Nothing } -- This function is used to make a ModLocation for a package module. Hence why -- we explicitly pass in the interface file suffixes. -mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String +mkHiOnlyModLocation :: FinderOpts -> OsPath -> OsPath -> OsPath -> OsPath -> ModLocation mkHiOnlyModLocation fopts hisuf dynhisuf path basename = let full_basename = path basename obj_fn = mkObjPath fopts full_basename basename dyn_obj_fn = mkDynObjPath fopts full_basename basename hie_fn = mkHiePath fopts full_basename basename - in ModLocation{ ml_hs_file = Nothing, - ml_hi_file = full_basename <.> hisuf, + in ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = full_basename <.> hisuf, -- Remove the .hi-boot suffix from -- hi_file, if it had one. We always -- want the name of the real .hi file -- in the ml_hi_file field. - ml_dyn_obj_file = dyn_obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, -- MP: TODO - ml_dyn_hi_file = full_basename <.> dynhisuf, - ml_obj_file = obj_fn, - ml_hie_file = hie_fn + ml_dyn_hi_file_ = full_basename <.> dynhisuf, + ml_obj_file_ = obj_fn, + ml_hie_file_ = hie_fn } -- | Constructs the filename of a .o file for a given source file. -- Does /not/ check whether the .o file exists mkObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath -mkObjPath fopts basename mod_basename = obj_basename <.> osuf + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath +mkObjPath fopts basename mod_basename = obj_basename OsPath.<.> osuf where odir = finder_objectDir fopts osuf = finder_objectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir OsPath. mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_o file for a given source file. -- Does /not/ check whether the .dyn_o file exists mkDynObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf where odir = finder_objectDir fopts dynosuf = finder_dynObjectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir mod_basename | otherwise = basename @@ -673,45 +675,45 @@ mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf -- Does /not/ check whether the .hi file exists mkHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiPath fopts basename mod_basename = hi_basename <.> hisuf where hidir = finder_hiDir fopts hisuf = finder_hiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_hi file for a given source file. -- Does /not/ check whether the .dyn_hi file exists mkDynHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf where hidir = finder_hiDir fopts dynhisuf = finder_dynHiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .hie file for a given source file. -- Does /not/ check whether the .hie file exists mkHiePath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf where hiedir = finder_hieDir fopts hiesuf = finder_hieSuf fopts - hie_basename | Just dir <- hiedir = dir mod_basename + hie_basename | Strict.Just dir <- hiedir = dir mod_basename | otherwise = basename @@ -726,23 +728,23 @@ mkStubPaths :: FinderOpts -> ModuleName -> ModLocation - -> FilePath + -> OsPath mkStubPaths fopts mod location = let stubdir = finder_stubDir fopts - mod_basename = moduleNameSlashes mod - src_basename = dropExtension $ expectJust "mkStubPaths" - (ml_hs_file location) + mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod + src_basename = OsPath.dropExtension $ Strict.expectJust "mkStubPaths" + (ml_hs_file_ location) stub_basename0 - | Just dir <- stubdir = dir mod_basename + | Strict.Just dir <- stubdir = dir mod_basename | otherwise = src_basename - stub_basename = stub_basename0 ++ "_stub" + stub_basename = stub_basename0 `mappend` unsafeEncodeUtf "_stub" in - stub_basename <.> "h" + stub_basename <.> unsafeEncodeUtf "h" -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -9,6 +9,7 @@ where import GHC.Prelude import GHC.Unit +import qualified GHC.Data.Strict as Strict import qualified Data.Map as M import GHC.Fingerprint import GHC.Platform.Ways @@ -16,6 +17,7 @@ import GHC.Platform.Ways import Data.IORef import GHC.Data.FastString import qualified Data.Set as Set +import System.OsPath (OsPath) -- | The 'FinderCache' maps modules to the result of -- searching for that module. It records the results of searching for @@ -31,7 +33,7 @@ data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState) data InstalledFindResult = InstalledFound ModLocation InstalledModule | InstalledNoPackage UnitId - | InstalledNotFound [FilePath] (Maybe UnitId) + | InstalledNotFound [OsPath] (Maybe UnitId) -- | The result of searching for an imported module. -- @@ -70,7 +72,7 @@ data FindResult -- -- Should be taken from 'DynFlags' via 'initFinderOpts'. data FinderOpts = FinderOpts - { finder_importPaths :: [FilePath] + { finder_importPaths :: [OsPath] -- ^ Where are we allowed to look for Modules and Source files , finder_lookupHomeInterfaces :: Bool -- ^ When looking up a home module: @@ -88,17 +90,17 @@ data FinderOpts = FinderOpts , finder_enableSuggestions :: Bool -- ^ If we encounter unknown modules, should we suggest modules -- that have a similar name. - , finder_workingDirectory :: Maybe FilePath + , finder_workingDirectory :: Strict.Maybe OsPath , finder_thisPackageName :: Maybe FastString , finder_hiddenModules :: Set.Set ModuleName , finder_reexportedModules :: Set.Set ModuleName - , finder_hieDir :: Maybe FilePath - , finder_hieSuf :: String - , finder_hiDir :: Maybe FilePath - , finder_hiSuf :: String - , finder_dynHiSuf :: String - , finder_objectDir :: Maybe FilePath - , finder_objectSuf :: String - , finder_dynObjectSuf :: String - , finder_stubDir :: Maybe FilePath + , finder_hieDir :: Strict.Maybe OsPath + , finder_hieSuf :: OsPath + , finder_hiDir :: Strict.Maybe OsPath + , finder_hiSuf :: OsPath + , finder_dynHiSuf :: OsPath + , finder_objectDir :: Strict.Maybe OsPath + , finder_objectSuf :: OsPath + , finder_dynObjectSuf :: OsPath + , finder_stubDir :: Strict.Maybe OsPath } deriving Show ===================================== compiler/GHC/Unit/Module/Location.hs ===================================== @@ -7,12 +7,21 @@ module GHC.Unit.Module.Location , addBootSuffixLocn , addBootSuffixLocnOut , removeBootSuffix + , ml_hs_file + , ml_hi_file + , ml_dyn_hi_file + , ml_obj_file + , ml_dyn_obj_file + , ml_hie_file ) where import GHC.Prelude import GHC.Unit.Types import GHC.Utils.Outputable +import qualified GHC.Data.Strict as Strict +import System.OsPath +import GHC.Data.OsPath -- | Module Location -- @@ -39,30 +48,30 @@ import GHC.Utils.Outputable data ModLocation = ModLocation { - ml_hs_file :: Maybe FilePath, + ml_hs_file_ :: Strict.Maybe OsPath, -- ^ The source file, if we have one. Package modules -- probably don't have source files. - ml_hi_file :: FilePath, + ml_hi_file_ :: OsPath, -- ^ Where the .hi file is, whether or not it exists -- yet. Always of form foo.hi, even if there is an -- hi-boot file (we add the -boot suffix later) - ml_dyn_hi_file :: FilePath, + ml_dyn_hi_file_ :: OsPath, -- ^ Where the .dyn_hi file is, whether or not it exists -- yet. - ml_obj_file :: FilePath, + ml_obj_file_ :: OsPath, -- ^ Where the .o file is, whether or not it exists yet. -- (might not exist either because the module hasn't -- been compiled yet, or because it is part of a -- unit with a .a file) - ml_dyn_obj_file :: FilePath, + ml_dyn_obj_file_ :: OsPath, -- ^ Where the .dy file is, whether or not it exists -- yet. - ml_hie_file :: FilePath + ml_hie_file_ :: OsPath -- ^ Where the .hie file is, whether or not it exists -- yet. } deriving Show @@ -71,8 +80,8 @@ instance Outputable ModLocation where ppr = text . show -- | Add the @-boot@ suffix to .hs, .hi and .o files -addBootSuffix :: FilePath -> FilePath -addBootSuffix path = path ++ "-boot" +addBootSuffix :: OsPath -> OsPath +addBootSuffix path = path `mappend` unsafeEncodeUtf "-boot" -- | Remove the @-boot@ suffix to .hs, .hi and .o files removeBootSuffix :: FilePath -> FilePath @@ -82,7 +91,7 @@ removeBootSuffix [] = error "removeBootSuffix: no -boot suffix" -- | Add the @-boot@ suffix if the @Bool@ argument is @True@ -addBootSuffix_maybe :: IsBootInterface -> FilePath -> FilePath +addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath addBootSuffix_maybe is_boot path = case is_boot of IsBoot -> addBootSuffix path NotBoot -> path @@ -95,22 +104,42 @@ addBootSuffixLocn_maybe is_boot locn = case is_boot of -- | Add the @-boot@ suffix to all file paths associated with the module addBootSuffixLocn :: ModLocation -> ModLocation addBootSuffixLocn locn - = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn) - , ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) } + = locn { ml_hs_file_ = fmap addBootSuffix (ml_hs_file_ locn) + , ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } -- | Add the @-boot@ suffix to all output file paths associated with the -- module, not including the input file itself addBootSuffixLocnOut :: ModLocation -> ModLocation addBootSuffixLocnOut locn - = locn { ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) + = locn { ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } +-- ---------------------------------------------------------------------------- +-- Helpers for backwards compatibility +-- ---------------------------------------------------------------------------- +ml_hs_file :: ModLocation -> Maybe FilePath +ml_hs_file = fmap unsafeDecodeUtf . Strict.toLazy . ml_hs_file_ + +ml_hi_file :: ModLocation -> FilePath +ml_hi_file = unsafeDecodeUtf . ml_hi_file_ + +ml_dyn_hi_file :: ModLocation -> FilePath +ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ + +ml_obj_file :: ModLocation -> FilePath +ml_obj_file = unsafeDecodeUtf . ml_obj_file_ + +ml_dyn_obj_file :: ModLocation -> FilePath +ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ + +ml_hie_file :: ModLocation -> FilePath +ml_hie_file = unsafeDecodeUtf . ml_hie_file_ ===================================== compiler/ghc.cabal.in ===================================== @@ -428,6 +428,7 @@ Library GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList + GHC.Data.OsPath GHC.Data.Pair GHC.Data.SmallArray GHC.Data.Stream ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe +Subproject commit 1ef6c187b31f85dfd7133b150b211ec9140cc84a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e67e4a42d53d3b37d1bfbed895b070c0bf95bbc8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e67e4a42d53d3b37d1bfbed895b070c0bf95bbc8 You're receiving 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 Apr 2 12:16:54 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 02 Apr 2024 08:16:54 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] fixup! rts: Make addDLL a wrapper around loadNativeObj Message-ID: <660bf73643d7_26e1f61616cb8961bd@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 5f1f6372 by Rodrigo Mesquita at 2024-04-02T13:12:43+01:00 fixup! rts: Make addDLL a wrapper around loadNativeObj - - - - - 1 changed file: - rts/linker/LoadNativeObjPosix.c Changes: ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,9 +1,10 @@ +#include "LinkerInternals.h" +#include "Rts.h" + #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) #include "CheckUnload.h" #include "ForeignExports.h" -#include "LinkerInternals.h" -#include "Rts.h" #include "RtsUtils.h" #include "Profiling.h" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f1f637262e27584c309420e6dffb7524fba3901 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f1f637262e27584c309420e6dffb7524fba3901 You're receiving 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 Apr 2 12:17:56 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 08:17:56 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` Message-ID: <660bf774b1503_26e1f616adfa09645b@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: df697526 by Fendor at 2024-04-02T14:17:36+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 10 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -75,7 +75,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -137,7 +137,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -148,7 +148,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -156,7 +156,7 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do let -- The order of these entries matters! @@ -194,14 +194,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -211,7 +211,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -235,7 +235,7 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int, Int, b) +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) putWithTables bh' put_payload = do let -- The order of these entries matters! @@ -380,7 +380,7 @@ initWriteNameTable = do ) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -389,7 +389,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -410,7 +410,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -434,7 +434,7 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: BinSymbolTable -> BinHandle -> Name -> IO () +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } @@ -460,7 +460,7 @@ putName BinSymbolTable{ -- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name - -> BinHandle -> IO Name + -> ReadBinHandle -> IO Name getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -111,9 +111,9 @@ writeHieFile hie_file_path hiefile = do put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next @@ -121,9 +121,9 @@ writeHieFile hie_file_path hiefile = do putSymbolTable bh symtab_next' symtab_map' -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -181,7 +181,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -190,7 +190,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -213,7 +213,7 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data @@ -232,21 +232,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -260,13 +260,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -276,12 +276,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable Name -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -334,7 +334,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -345,7 +345,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -37,7 +37,7 @@ computeFingerprint a = do -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -119,10 +119,10 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = case findUserDataWriter Proxy bh of tbl -> @@ -2445,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -89,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq -import Data.Proxy +import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -322,7 +322,7 @@ putObject bh mod_name deps os = do -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -330,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -345,7 +345,7 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) @@ -353,7 +353,7 @@ getObjectBody bh0 mod_name = do block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -364,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -393,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -409,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -779,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -31,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -87,7 +89,6 @@ module GHC.Utils.Binary initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, - -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..) ) where @@ -171,70 +172,83 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noReaderUserData noWriterUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_reader :: ReaderUserData, -- sigh, need parameterized modules :-) - bh_writer :: WriterUserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: !WriterUserData, + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) + } + +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: !ReaderUserData, + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getReaderUserData :: BinHandle -> ReaderUserData -getReaderUserData bh = bh_reader bh +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh -getWriterUserData :: BinHandle -> WriterUserData -getWriterUserData bh = bh_writer bh +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setWriterUserData :: BinHandle -> WriterUserData -> BinHandle -setWriterUserData bh us = bh { bh_writer = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } -setReaderUserData :: BinHandle -> ReaderUserData -> BinHandle -setReaderUserData bh us = bh { bh_reader = us } +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } -addReaderToUserData :: SomeBinaryReader -> BinHandle -> BinHandle +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh - { bh_reader = (bh_reader bh) - { ud_reader_data = Map.insert typRep cache (ud_reader_data (bh_reader bh)) + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) } } -addWriterToUserData :: SomeBinaryWriter -> BinHandle -> BinHandle +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh - { bh_writer = (bh_writer bh) - { ud_writer_data = Map.insert typRep cache (ud_writer_data (bh_writer bh)) + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) } } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -253,23 +267,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -277,42 +291,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } + +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -321,20 +350,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -355,7 +387,7 @@ expandBin (BinMem _ _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -371,7 +403,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -392,8 +424,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -414,39 +446,37 @@ putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -454,7 +484,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -467,7 +497,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -479,7 +509,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -500,10 +530,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -526,15 +556,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -551,15 +581,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -575,15 +605,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -603,15 +633,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -1022,63 +1052,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1086,14 +1116,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1183,31 +1213,31 @@ mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReade mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb data BinaryReader s = BinaryReader - { getEntry :: BinHandle -> IO s + { getEntry :: ReadBinHandle -> IO s } data BinaryWriter s = BinaryWriter - { putEntry :: BinHandle -> s -> IO () + { putEntry :: WriteBinHandle -> s -> IO () } -mkWriter :: (BinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s mkWriter f = BinaryWriter { putEntry = f } -mkReader :: (BinHandle -> IO s) -> BinaryReader s +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s mkReader f = BinaryReader { getEntry = f } -findUserDataReader :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryReader a +findUserDataReader :: forall a . Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a findUserDataReader query bh = case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of Nothing -> panic $ "Failed to find BinaryReader for key " ++ show (typeRep query) Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader -findUserDataWriter :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryWriter a +findUserDataWriter :: forall a . Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a findUserDataWriter query bh = case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of Nothing -> panic $ "Failed to find BinaryWriter for key " ++ show (typeRep query) @@ -1224,8 +1254,8 @@ noWriterUserData = WriterUserData { ud_writer_data = Map.empty } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) -> ReaderUserData newReadState get_name get_fs = mkReaderUserData @@ -1233,9 +1263,9 @@ newReadState get_name get_fs = , mkSomeBinaryReader $ mkReader get_fs ] -newWriteState :: (BinHandle -> Name -> IO ()) +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) + -> (WriteBinHandle -> FastString -> IO ()) -> WriterUserData newWriteState put_binding_name put_fs = mkWriterUserData @@ -1254,12 +1284,12 @@ data SomeWriterTable f = forall a . Typeable a => SomeWriterTable (f (WriterTable, BinaryWriter a)) data ReaderTable a = ReaderTable - { getTable :: BinHandle -> IO (SymbolTable a) + { getTable :: ReadBinHandle -> IO (SymbolTable a) , mkReaderFromTable :: SymbolTable a -> BinaryReader a } data WriterTable = WriterTable - { putTable :: BinHandle -> IO Int + { putTable :: WriteBinHandle -> IO Int } --------------------------------------------------------- @@ -1299,14 +1329,14 @@ initFastStringWriterTable = do , mkWriter $ putDictFastString bin_dict ) -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1315,12 +1345,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1357,34 +1387,34 @@ type SymbolTable a = Array Int a -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit d559cde5afeb9323861428a7317a59be055b9e13 +Subproject commit 799390d1c6d59a606c3dd00dea057baa26ed0c2f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df697526f836456e06b1c965119edb4be238875d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df697526f836456e06b1c965119edb4be238875d You're receiving 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 Apr 2 12:20:10 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 08:20:10 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact-with-gen-sym-table] 2 commits: Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` Message-ID: <660bf7fa9010d_26e1f617d23cc9721c@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact-with-gen-sym-table at Glasgow Haskell Compiler / GHC Commits: 47374615 by Fendor at 2024-04-02T14:18:32+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - fc469160 by Fendor at 2024-04-02T14:19:50+02:00 Fixup: Generic Symbol Table - - - - - 10 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -75,7 +75,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -137,7 +137,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -148,7 +148,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -156,7 +156,7 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do let -- The order of these entries matters! @@ -194,14 +194,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -211,7 +211,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -235,7 +235,7 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int, Int, b) +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) putWithTables bh' put_payload = do let -- The order of these entries matters! @@ -380,7 +380,7 @@ initWriteNameTable = do ) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -389,7 +389,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -410,7 +410,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -434,7 +434,7 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: BinSymbolTable -> BinHandle -> Name -> IO () +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } @@ -460,7 +460,7 @@ putName BinSymbolTable{ -- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name - -> BinHandle -> IO Name + -> ReadBinHandle -> IO Name getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -111,19 +111,19 @@ writeHieFile hie_file_path hiefile = do put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next symtab_map' <- readIORef symtab_map putSymbolTable bh symtab_next' symtab_map' - -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + -- write the tellBinWriter pointer at the front of the file + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -181,7 +181,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -190,7 +190,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -213,7 +213,7 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data @@ -232,21 +232,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -260,13 +260,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -276,12 +276,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable Name -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -334,7 +334,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -345,7 +345,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -37,7 +37,7 @@ computeFingerprint a = do -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -119,10 +119,10 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = case findUserDataWriter Proxy bh of tbl -> @@ -2445,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -90,10 +90,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq -import Data.Proxy +import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -322,7 +322,7 @@ putObject bh mod_name deps os = do -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -330,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -345,7 +345,7 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) @@ -353,7 +353,7 @@ getObjectBody bh0 mod_name = do block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -364,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -393,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -409,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -779,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -31,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -88,6 +90,12 @@ module GHC.Utils.Binary putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, + -- * Generic Symbol that can be used for user-defined deduplication tables. + GenericSymbolTable(..), + initGenericSymbolTable, + putGenericSymbolTable, getGenericSymbolTable, + putGenericSymTab, getGenericSymtab, + -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..) ) where @@ -171,70 +179,83 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noReaderUserData noWriterUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_reader :: ReaderUserData, -- sigh, need parameterized modules :-) - bh_writer :: WriterUserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: !WriterUserData, + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) + } + +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: !ReaderUserData, + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getReaderUserData :: BinHandle -> ReaderUserData -getReaderUserData bh = bh_reader bh +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh -getWriterUserData :: BinHandle -> WriterUserData -getWriterUserData bh = bh_writer bh +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setWriterUserData :: BinHandle -> WriterUserData -> BinHandle -setWriterUserData bh us = bh { bh_writer = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } -setReaderUserData :: BinHandle -> ReaderUserData -> BinHandle -setReaderUserData bh us = bh { bh_reader = us } +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } -addReaderToUserData :: SomeBinaryReader -> BinHandle -> BinHandle +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh - { bh_reader = (bh_reader bh) - { ud_reader_data = Map.insert typRep cache (ud_reader_data (bh_reader bh)) + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) } } -addWriterToUserData :: SomeBinaryWriter -> BinHandle -> BinHandle +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh - { bh_writer = (bh_writer bh) - { ud_writer_data = Map.insert typRep cache (ud_writer_data (bh_writer bh)) + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) } } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -253,23 +274,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -277,42 +298,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) + +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -321,20 +357,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -355,7 +394,7 @@ expandBin (BinMem _ _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -371,7 +410,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -392,8 +431,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -414,39 +453,37 @@ putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -454,7 +491,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -467,7 +504,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -479,7 +516,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -500,10 +537,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -526,15 +563,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -551,15 +588,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -575,15 +612,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -603,15 +640,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -1022,63 +1059,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1086,14 +1123,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1183,31 +1220,31 @@ mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReade mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb data BinaryReader s = BinaryReader - { getEntry :: BinHandle -> IO s + { getEntry :: ReadBinHandle -> IO s } data BinaryWriter s = BinaryWriter - { putEntry :: BinHandle -> s -> IO () + { putEntry :: WriteBinHandle -> s -> IO () } -mkWriter :: (BinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s mkWriter f = BinaryWriter { putEntry = f } -mkReader :: (BinHandle -> IO s) -> BinaryReader s +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s mkReader f = BinaryReader { getEntry = f } -findUserDataReader :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryReader a +findUserDataReader :: forall a . Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a findUserDataReader query bh = case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of Nothing -> panic $ "Failed to find BinaryReader for key " ++ show (typeRep query) Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader -findUserDataWriter :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryWriter a +findUserDataWriter :: forall a . Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a findUserDataWriter query bh = case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of Nothing -> panic $ "Failed to find BinaryWriter for key " ++ show (typeRep query) @@ -1224,8 +1261,8 @@ noWriterUserData = WriterUserData { ud_writer_data = Map.empty } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) -> ReaderUserData newReadState get_name get_fs = mkReaderUserData @@ -1233,9 +1270,9 @@ newReadState get_name get_fs = , mkSomeBinaryReader $ mkReader get_fs ] -newWriteState :: (BinHandle -> Name -> IO ()) +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) + -> (WriteBinHandle -> FastString -> IO ()) -> WriterUserData newWriteState put_binding_name put_fs = mkWriterUserData @@ -1254,14 +1291,80 @@ data SomeWriterTable f = forall a . Typeable a => SomeWriterTable (f (WriterTable, BinaryWriter a)) data ReaderTable a = ReaderTable - { getTable :: BinHandle -> IO (SymbolTable a) + { getTable :: ReadBinHandle -> IO (SymbolTable a) , mkReaderFromTable :: SymbolTable a -> BinaryReader a } data WriterTable = WriterTable - { putTable :: BinHandle -> IO Int + { putTable :: WriteBinHandle -> IO Int + } + +-- ---------------------------------------------------------------------------- +-- Common data structures for constructing and maintaining lookup tables for +-- binary serialisation and deserialisation. +-- ---------------------------------------------------------------------------- + +data GenericSymbolTable a = GenericSymbolTable + { gen_symtab_next :: !FastMutInt + -- ^ The next index to use + , gen_symtab_map :: !(IORef (Map.Map a Int)) + -- ^ Given a symbol, find the symbol } +initGenericSymbolTable :: IO (GenericSymbolTable a) +initGenericSymbolTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef Map.empty + pure $ GenericSymbolTable + { gen_symtab_next = symtab_next + , gen_symtab_map = symtab_map + } + +putGenericSymbolTable :: forall a. GenericSymbolTable a -> (WriteBinHandle -> a -> IO ()) -> WriteBinHandle -> IO Int +putGenericSymbolTable gen_sym_tab serialiser bh = do + table_count <- readFastMutInt symtab_next + symtab_map <- readIORef symtab_map + putGenericSymbolTable bh table_count symtab_map + pure table_count + where + symtab_map = gen_symtab_map gen_sym_tab + symtab_next = gen_symtab_next gen_sym_tab + putGenericSymbolTable :: WriteBinHandle -> Int -> Map.Map a Int -> IO () + putGenericSymbolTable bh name_count symtab = do + put_ bh name_count + let genElements = elems (array (0,name_count-1) (fmap swap $ Map.toList symtab)) + mapM_ (\n -> serialiser bh n) genElements + +getGenericSymbolTable :: forall a. (ReadBinHandle -> IO a) -> ReadBinHandle -> IO (SymbolTable a) +getGenericSymbolTable deserialiser bh = do + sz <- get bh :: IO Int + mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int a) + forM_ [0..(sz-1)] $ \i -> do + f <- deserialiser bh + writeArray mut_arr i f + unsafeFreeze mut_arr + +putGenericSymTab :: (Ord a, Binary a) => GenericSymbolTable a -> WriteBinHandle -> a -> IO () +putGenericSymTab GenericSymbolTable{ + gen_symtab_map = symtab_map_ref, + gen_symtab_next = symtab_next } + bh val = do + symtab_map <- readIORef symtab_map_ref + case Map.lookup val symtab_map of + Just off -> put_ bh (fromIntegral off :: Word32) + Nothing -> do + off <- readFastMutInt symtab_next + writeFastMutInt symtab_next (off+1) + writeIORef symtab_map_ref + $! Map.insert val off symtab_map + put_ bh (fromIntegral off :: Word32) + +getGenericSymtab :: Binary a => SymbolTable a + -> ReadBinHandle -> IO a +getGenericSymtab symtab bh = do + i :: Word32 <- get bh + return $! symtab ! fromIntegral i + --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- @@ -1299,14 +1402,14 @@ initFastStringWriterTable = do , mkWriter $ putDictFastString bin_dict ) -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1315,12 +1418,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1357,34 +1460,34 @@ type SymbolTable a = Array Int a -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit d559cde5afeb9323861428a7317a59be055b9e13 +Subproject commit 799390d1c6d59a606c3dd00dea057baa26ed0c2f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/345e81f47d9f811c124207ce51cf8f95bdb01b1e...fc469160c47daf12cdee33019df1e16bfc470375 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/345e81f47d9f811c124207ce51cf8f95bdb01b1e...fc469160c47daf12cdee33019df1e16bfc470375 You're receiving 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 Apr 2 12:28:18 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 08:28:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fendor/fix-thunks-name-and-ui Message-ID: <660bf9e261b70_26e1f6190f94c994cd@gitlab.mail> Hannes Siebenhandl pushed new branch wip/fendor/fix-thunks-name-and-ui at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/fix-thunks-name-and-ui You're receiving 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 Apr 2 12:29:28 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 02 Apr 2024 08:29:28 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] fixup! fixup! fixup! rts: Make addDLL a wrapper around loadNativeObj Message-ID: <660bfa28e1d0c_26e1f6195c864996cd@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: b86dfbc9 by Rodrigo Mesquita at 2024-04-02T13:29:13+01:00 fixup! fixup! fixup! rts: Make addDLL a wrapper around loadNativeObj - - - - - 1 changed file: - rts/linker/PEi386.h Changes: ===================================== rts/linker/PEi386.h ===================================== @@ -60,7 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); -SymbolAddr *lookupSymbolInDLL_PEi386 (SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent) +SymbolAddr *lookupSymbolInDLL_PEi386 (SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b86dfbc9bf32f2e2de08dc9242b478c5f7edf1a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b86dfbc9bf32f2e2de08dc9242b478c5f7edf1a4 You're receiving 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 Apr 2 12:34:55 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 02 Apr 2024 08:34:55 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] fixup! rts: Make addDLL a wrapper around loadNativeObj Message-ID: <660bfb6f6566d_26e1f61b21cbc103788@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 4704c5ef by Rodrigo Mesquita at 2024-04-02T13:34:44+01:00 fixup! rts: Make addDLL a wrapper around loadNativeObj - - - - - 4 changed files: - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== rts/Linker.c ===================================== @@ -643,7 +643,13 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; @@ -652,7 +658,6 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,18 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r = addDLL_PEi386(path, NULL); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1883,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,7 +1,10 @@ -#include "CheckUnload.h" -#include "ForeignExports.h" #include "LinkerInternals.h" #include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" #include "RtsUtils.h" #include "Profiling.h" @@ -208,4 +211,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1141,47 +1141,55 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent); + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+1,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4704c5ef2f416ff36d91c9b3387f3cdf94441ecd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4704c5ef2f416ff36d91c9b3387f3cdf94441ecd You're receiving 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 Apr 2 12:36:24 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 08:36:24 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] fixup! clarify Note [Preproccesing invocations] Message-ID: <660bfbc8d7bfc_26e1f61c60ee810409a@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: 466682d0 by Fendor at 2024-04-02T14:36:09+02:00 fixup! clarify Note [Preproccesing invocations] - - - - - 1 changed file: - compiler/GHC/Utils/Binary.hs Changes: ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -126,7 +126,6 @@ import qualified Data.Map.Strict as Map import Data.Set ( Set ) import qualified Data.Set as Set import Data.Time -import Data.Tuple (swap) import Data.List (unfoldr) import Data.Typeable import System.IO as IO View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/466682d09a3a0ecd1862807b5194e7de3ba01640 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/466682d09a3a0ecd1862807b5194e7de3ba01640 You're receiving 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 Apr 2 12:37:10 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 08:37:10 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] 2 commits: Refactor the Binary serialisation interface Message-ID: <660bfbf67a01a_26e1f61cc63b010481@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: 957df705 by Fendor at 2024-04-02T14:36:35+02:00 Refactor the Binary serialisation interface The end goal is to dynamically add deduplication tables for `ModIface` interface serialisation. We identify two main points of interest that make this difficult: 1. UserData hardcodes what `Binary` instances can have deduplication tables. Moreover, it heavily uses partial functions. 2. GHC.Iface.Binary hardcodes the deduplication tables for 'Name' and 'FastString', making it difficult to add more deduplication. Instead of having a single `UserData` record with fields for all the types that can have deduplication tables, we allow to provide custom serialisers for any `Typeable`. These are wrapped in existentials and stored in a `Map` indexed by their respective `TypeRep`. The `Binary` instance of the type to deduplicate still needs to explicitly look up the decoder via `findUserDataReader` and `findUserDataWriter`, which is no worse than the status-quo. `Map` was chosen as microbenchmarks indicate it is the fastest for a small number of keys (< 10). To generalise the deduplication table serialisation mechanism, we introduce the types `ReaderTable` and `WriterTable` which provide a simple interface that is sufficient to implement a general purpose deduplication mechanism for `writeBinIface` and `readBinIface`. This allows us to provide a list of deduplication tables for serialisation that can be extended more easily, for example for `IfaceTyCon`, see the issue https://gitlab.haskell.org/ghc/ghc/-/issues/24540 for more motivation. In addition to ths refactoring, we split `UserData` into `ReaderUserData` and `WriterUserData`, to avoid partial functions. Bump haddock submodule to accomodate for `UserData` split. - - - - - d3b37648 by Fendor at 2024-04-02T14:36:35+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 15 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -29,7 +29,6 @@ module GHC.Iface.Binary ( import GHC.Prelude -import GHC.Tc.Utils.Monad import GHC.Builtin.Utils ( isKnownKeyName, lookupKnownKeyName ) import GHC.Unit import GHC.Unit.Module.ModIface @@ -54,6 +53,7 @@ import Data.Char import Data.Word import Data.IORef import Control.Monad +import Data.Functor.Identity -- --------------------------------------------------------------------------- -- Reading and writing binary interface files @@ -75,7 +75,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -121,6 +121,8 @@ readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do pure (src_hash, bh) -- | Read an interface file. +-- +-- See Note [Iface Binary Serialisation] for details. readBinIface :: Profile -> NameCache @@ -135,7 +137,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -146,7 +148,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -154,24 +156,32 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do - -- Read the dictionary - -- The next word in the file is a pointer to where the dictionary is - -- (probably at the end of the file) - dict <- Binary.forwardGet bh (getDictionary bh) - - -- Initialise the user-data field of bh - let bh_fs = setUserData bh $ newReadState (error "getSymtabName") - (getDictFastString dict) - - symtab <- Binary.forwardGet bh_fs (getSymbolTable bh_fs name_cache) - - -- It is only now that we know how to get a Name - return $ setUserData bh $ newReadState (getSymtabName name_cache dict symtab) - (getDictFastString dict) - --- | Write an interface file + let + -- The order of these entries matters! + -- + -- See Note [Iface Binary Serialiser Order] for details. + tables :: [SomeReaderTable IO] + tables = + [ SomeReaderTable initFastStringReaderTable + , SomeReaderTable (initReadNameCachedBinary name_cache) + ] + + tables <- traverse (\(SomeReaderTable tblM) -> tblM >>= pure . SomeReaderTable . pure) tables + + final_bh <- foldM (\bh (SomeReaderTable (tbl' :: Identity (ReaderTable a))) -> do + let tbl = runIdentity tbl' + res <- Binary.forwardGet bh (getTable tbl bh) + let newDecoder = mkReaderFromTable tbl res + pure $ addReaderToUserData (mkSomeBinaryReader newDecoder) bh + ) bh tables + + pure final_bh + +-- | Write an interface file. +-- +-- See Note [Iface Binary Serialisation] for details. writeBinIface :: Profile -> TraceBinIFace -> FilePath -> ModIface -> IO () writeBinIface profile traceBinIface hi_path mod_iface = do bh <- openBinMem initBinMemSize @@ -184,14 +194,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -201,7 +211,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -225,43 +235,39 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int,Int,b) -putWithTables bh put_payload = do - -- initialize state for the name table and the FastString table. - symtab_next <- newFastMutInt 0 - symtab_map <- newIORef emptyUFM - let bin_symtab = BinSymbolTable - { bin_symtab_next = symtab_next - , bin_symtab_map = symtab_map - } - - (bh_fs, bin_dict, put_dict) <- initFSTable bh - - (fs_count,(name_count,r)) <- forwardPut bh (const put_dict) $ do - - -- NB. write the dictionary after the symbol table, because - -- writing the symbol table may create more dictionary entries. - let put_symtab = do - name_count <- readFastMutInt symtab_next - symtab_map <- readIORef symtab_map - putSymbolTable bh_fs name_count symtab_map - pure name_count - - forwardPut bh_fs (const put_symtab) $ do - - -- BinHandle with FastString and Name writing support - let ud_fs = getUserData bh_fs - let ud_name = ud_fs - { ud_put_nonbinding_name = putName bin_dict bin_symtab - , ud_put_binding_name = putName bin_dict bin_symtab - } - let bh_name = setUserData bh ud_name - - put_payload bh_name - - return (name_count, fs_count, r) - - +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) +putWithTables bh' put_payload = do + let + -- The order of these entries matters! + -- + -- See Note [Iface Binary Serialiser Order] for details. + writerTables = + [ SomeWriterTable initFastStringWriterTable + , SomeWriterTable initWriteNameTable + ] + + tables <- traverse (\(SomeWriterTable worker) -> worker >>= pure . SomeWriterTable . pure) writerTables + + let writerUserData = + mkWriterUserData $ + map + (\(SomeWriterTable tbl') -> mkSomeBinaryWriter (snd $ runIdentity tbl')) + tables + + let bh = setWriterUserData bh' writerUserData + (fs_count : name_count : _, r) <- + putAllTables bh (fmap (\(SomeWriterTable tbl) -> fst $ runIdentity tbl) tables) $ do + put_payload bh + + return (name_count, fs_count, r) + where + putAllTables _ [] act = do + a <- act + pure ([], a) + putAllTables bh (x : xs) act = do + (r, (res, a)) <- forwardPut bh (const $ putTable x bh) $ do + putAllTables bh xs act + pure (r : res, a) -- | Initial ram buffer to allocate for writing interface files initBinMemSize :: Int @@ -273,11 +279,108 @@ binaryInterfaceMagic platform | otherwise = FixedLengthEncoding 0x1face64 +{- +Note [Iface Binary Serialisation] +~~~~~~~~~~~~~~~~~~~ +When we serialise a 'ModIface', many symbols are redundant. +For example, there can be duplicated 'FastString's and 'Name's. +To save space, we deduplicate some symbols, such as 'FastString' and 'Name', +by maintaining a table of already seen symbols. +When serialising a symbol, we lookup whether we have encountered the symbol before. +If yes, we write the index of the symbol, otherwise we generate a new index and store it in the table. + +Besides saving a lot of disk space, this additionally enables us to automatically share +these symbols when we read the 'ModIface' from disk, without additional mechanisms such as 'FastStringTable'. + +Note [Iface Binary Serialiser Order] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Serialisation of 'ModIface' uses tables to deduplicate symbols that occur often. + +After 'ModIface' has been written to disk, we write the deduplication tables. +Writing a table may add additional entries to *other* deduplication tables, thus +we need to make sure that the symbol table we serialise only depends on +deduplication tables that haven't been written to disk yet. + +For example, assume we maintain deduplication tables for 'FastString' and 'Name'. +The symbol 'Name' depends on 'FastString', so serialising a 'Name' may add a 'FastString' +to the 'FastString' deduplication table. +Thus, 'Name' table needs to be serialised to disk before the 'FastString' table. + +When we read the 'ModIface' from disk, we consequentially need to read the 'FastString' +deduplication table from disk, before we can deserialise the 'Name' deduplication table. +Therefore, before we serialise the tables, we write forward pointers that allow us to jump ahead +to the table we need to deserialise first. + +Here, a visualisation of the table structure we currently have: + +┌──────────────┐ +│ Headers │ +├──────────────┤ +│ │ +│ ModIface │ +│ Payload │ +│ │ +├──────────────┤ +│ Ptr FS ├───────────┐ +├──────────────┤ │ +│ Ptr Name ├────────┐ │ +├──────────────┤ │ │ +│ │ │ │ +│ Name Table │◄───────┘ │ +│ │ │ +├──────────────┤ │ +│ │ │ +│ FS Table │◄──────────┘ +│ │ +└──────────────┘ + +-} + + -- ----------------------------------------------------------------------------- -- The symbol table -- -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () + +initReadNameCachedBinary :: NameCache -> IO (ReaderTable Name) +initReadNameCachedBinary cache = do + return $ + ReaderTable + { getTable = \bh -> getSymbolTable bh cache + , mkReaderFromTable = \tbl -> mkReader (getSymtabName tbl) + } + +data BinSymbolTable = BinSymbolTable { + bin_symtab_next :: !FastMutInt, -- The next index to use + bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) + -- indexed by Name + } + +initWriteNameTable :: IO (WriterTable, BinaryWriter Name) +initWriteNameTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef emptyUFM + let bin_symtab = + BinSymbolTable + { bin_symtab_next = symtab_next + , bin_symtab_map = symtab_map + } + + let put_symtab bh = do + name_count <- readFastMutInt symtab_next + symtab_map <- readIORef symtab_map + putSymbolTable bh name_count symtab_map + pure name_count + + return + ( WriterTable + { putTable = put_symtab + } + , mkWriter $ putName bin_symtab + ) + + +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -286,7 +389,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -307,7 +410,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -331,8 +434,8 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: FSTable -> BinSymbolTable -> BinHandle -> Name -> IO () -putName _dict BinSymbolTable{ +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () +putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } bh name @@ -356,10 +459,9 @@ putName _dict BinSymbolTable{ put_ bh (fromIntegral off :: Word32) -- See Note [Symbol table representation of names] -getSymtabName :: NameCache - -> Dictionary -> SymbolTable - -> BinHandle -> IO Name -getSymtabName _name_cache _dict symtab bh = do +getSymtabName :: SymbolTable Name + -> ReadBinHandle -> IO Name +getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of 0x00000000 -> return $! symtab ! fromIntegral i @@ -376,10 +478,3 @@ getSymtabName _name_cache _dict symtab bh = do Just n -> n _ -> pprPanic "getSymtabName:unknown name tag" (ppr i) - -data BinSymbolTable = BinSymbolTable { - bin_symtab_next :: !FastMutInt, -- The next index to use - bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) - -- indexed by Name - } - ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -105,15 +105,15 @@ writeHieFile hie_file_path hiefile = do hie_dict_map = dict_map_ref } -- put the main thing - let bh = setUserData bh0 $ newWriteState (putName hie_symtab) - (putName hie_symtab) - (putFastString hie_dict) + let bh = setWriterUserData bh0 + $ newWriteState (putName hie_symtab) + (putFastString hie_dict) put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next @@ -121,9 +121,9 @@ writeHieFile hie_file_path hiefile = do putSymbolTable bh symtab_next' symtab_map' -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -181,7 +181,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -190,7 +190,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -213,15 +213,16 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data bh1 <- do - let bh1 = setUserData bh0 $ newReadState (error "getSymtabName") - (getDictFastString dict) + let bh1 = setReaderUserData bh0 + $ newReadState (error "getSymtabName") + (getDictFastString dict) symtab <- get_symbol_table bh1 - let bh1' = setUserData bh1 + let bh1' = setReaderUserData bh1 $ newReadState (getSymTabName symtab) (getDictFastString dict) return bh1' @@ -231,21 +232,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -259,13 +260,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -275,12 +276,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -333,7 +334,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -344,7 +345,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -520,7 +520,7 @@ checkFlagHash :: HscEnv -> ModIface -> IO RecompileRequired checkFlagHash hsc_env iface = do let logger = hsc_logger hsc_env let old_hash = mi_flag_hash (mi_final_exts iface) - new_hash <- fingerprintDynFlags hsc_env (mi_module iface) putNameLiterally + new_hash <- fingerprintDynFlags hsc_env (mi_module iface) case old_hash == new_hash of True -> up_to_date logger (text "Module flags unchanged") False -> out_of_date_hash logger FlagsChanged @@ -533,7 +533,6 @@ checkOptimHash hsc_env iface = do let logger = hsc_logger hsc_env let old_hash = mi_opt_hash (mi_final_exts iface) new_hash <- fingerprintOptFlags (hsc_dflags hsc_env) - putNameLiterally if | old_hash == new_hash -> up_to_date logger (text "Optimisation flags unchanged") | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env) @@ -549,7 +548,6 @@ checkHpcHash hsc_env iface = do let logger = hsc_logger hsc_env let old_hash = mi_hpc_hash (mi_final_exts iface) new_hash <- fingerprintHpcFlags (hsc_dflags hsc_env) - putNameLiterally if | old_hash == new_hash -> up_to_date logger (text "HPC flags unchanged") | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env) @@ -960,7 +958,6 @@ addFingerprints -> IO ModIface addFingerprints hsc_env iface0 = do - eps <- hscEPS hsc_env let decls = mi_decls iface0 decl_warn_fn = mkIfaceDeclWarnCache (fromIfaceWarnings $ mi_warns iface0) @@ -1023,40 +1020,6 @@ addFingerprints hsc_env iface0 groups :: [SCC IfaceDeclABI] groups = stronglyConnCompFromEdgedVerticesOrd edges - global_hash_fn = mkHashFun hsc_env eps - - -- How to output Names when generating the data to fingerprint. - -- Here we want to output the fingerprint for each top-level - -- Name, whether it comes from the current module or another - -- module. In this way, the fingerprint for a declaration will - -- change if the fingerprint for anything it refers to (transitively) - -- changes. - mk_put_name :: OccEnv (OccName,Fingerprint) - -> BinHandle -> Name -> IO () - mk_put_name local_env bh name - | isWiredInName name = putNameLiterally bh name - -- wired-in names don't have fingerprints - | otherwise - = assertPpr (isExternalName name) (ppr name) $ - let hash | nameModule name /= semantic_mod = global_hash_fn name - -- Get it from the REAL interface!! - -- This will trigger when we compile an hsig file - -- and we know a backing impl for it. - -- See Note [Identity versus semantic module] - | semantic_mod /= this_mod - , not (isHoleModule semantic_mod) = global_hash_fn name - | otherwise = return (snd (lookupOccEnv local_env (getOccName name) - `orElse` pprPanic "urk! lookup local fingerprint" - (ppr name $$ ppr local_env))) - -- This panic indicates that we got the dependency - -- analysis wrong, because we needed a fingerprint for - -- an entity that wasn't in the environment. To debug - -- it, turn the panic into a trace, uncomment the - -- pprTraces below, run the compile again, and inspect - -- the output and the generated .hi file with - -- --show-iface. - in hash >>= put_ bh - -- take a strongly-connected group of declarations and compute -- its fingerprint. @@ -1067,23 +1030,18 @@ addFingerprints hsc_env iface0 [(Fingerprint,IfaceDecl)]) fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi) - = do let hash_fn = mk_put_name local_env - decl = abiDecl abi + = do let decl = abiDecl abi --pprTrace "fingerprinting" (ppr (ifName decl) ) $ do - hash <- computeFingerprint hash_fn abi + hash <- computeFingerprint abi env' <- extend_hash_env local_env (hash,decl) return (env', (hash,decl) : decls_w_hashes) fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis) = do let stable_abis = sortBy cmp_abiNames abis stable_decls = map abiDecl stable_abis - local_env1 <- foldM extend_hash_env local_env - (zip (map mkRecFingerprint [0..]) stable_decls) - -- See Note [Fingerprinting recursive groups] - let hash_fn = mk_put_name local_env1 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do -- put the cycle in a canonical order - hash <- computeFingerprint hash_fn stable_abis + hash <- computeFingerprint stable_abis let pairs = zip (map (bumpFingerprint hash) [0..]) stable_decls -- See Note [Fingerprinting recursive groups] local_env2 <- foldM extend_hash_env local_env pairs @@ -1156,11 +1114,10 @@ addFingerprints hsc_env iface0 -- instances yourself, no need to consult hs-boot; if you do load the -- interface into EPS, you will see a duplicate orphan instance. - orphan_hash <- computeFingerprint (mk_put_name local_env) - (map ifDFun orph_insts, orph_rules, orph_fis) + orphan_hash <- computeFingerprint (map ifDFun orph_insts, orph_rules, orph_fis) -- Hash of the transitive things in dependencies - dep_hash <- computeFingerprint putNameLiterally + dep_hash <- computeFingerprint (dep_sig_mods (mi_deps iface0), dep_boot_mods (mi_deps iface0), -- Trusted packages are like orphans @@ -1170,7 +1127,7 @@ addFingerprints hsc_env iface0 -- the export list hash doesn't depend on the fingerprints of -- the Names it mentions, only the Names themselves, hence putNameLiterally. - export_hash <- computeFingerprint putNameLiterally + export_hash <- computeFingerprint (mi_exports iface0, orphan_hash, dep_hash, @@ -1229,11 +1186,11 @@ addFingerprints hsc_env iface0 -- - (some of) dflags -- it returns two hashes, one that shouldn't change -- the abi hash and one that should - flag_hash <- fingerprintDynFlags hsc_env this_mod putNameLiterally + flag_hash <- fingerprintDynFlags hsc_env this_mod - opt_hash <- fingerprintOptFlags dflags putNameLiterally + opt_hash <- fingerprintOptFlags dflags - hpc_hash <- fingerprintHpcFlags dflags putNameLiterally + hpc_hash <- fingerprintHpcFlags dflags plugin_hash <- fingerprintPlugins (hsc_plugins hsc_env) @@ -1243,7 +1200,7 @@ addFingerprints hsc_env iface0 -- - orphans -- - deprecations -- - flag abi hash - mod_hash <- computeFingerprint putNameLiterally + mod_hash <- computeFingerprint (map fst sorted_decls, export_hash, -- includes orphan_hash mi_warns iface0) @@ -1255,7 +1212,7 @@ addFingerprints hsc_env iface0 -- - usages -- - deps (home and external packages, dependent files) -- - hpc - iface_hash <- computeFingerprint putNameLiterally + iface_hash <- computeFingerprint (mod_hash, mi_src_hash iface0, ann_fn (mkVarOccFS (fsLit "module")), -- See mkIfaceAnnCache @@ -1594,57 +1551,6 @@ mkOrphMap get_key decls = (extendOccEnv_Acc (:) Utils.singleton non_orphs occ d, orphs) | otherwise = (non_orphs, d:orphs) --- ----------------------------------------------------------------------------- --- Look up parents and versions of Names - --- This is like a global version of the mi_hash_fn field in each ModIface. --- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get --- the parent and version info. - -mkHashFun - :: HscEnv -- needed to look up versions - -> ExternalPackageState -- ditto - -> (Name -> IO Fingerprint) -mkHashFun hsc_env eps name - | isHoleModule orig_mod - = lookup (mkHomeModule home_unit (moduleName orig_mod)) - | otherwise - = lookup orig_mod - where - home_unit = hsc_home_unit hsc_env - dflags = hsc_dflags hsc_env - hpt = hsc_HUG hsc_env - pit = eps_PIT eps - ctx = initSDocContext dflags defaultUserStyle - occ = nameOccName name - orig_mod = nameModule name - lookup mod = do - massertPpr (isExternalName name) (ppr name) - iface <- case lookupIfaceByModule hpt pit mod of - Just iface -> return iface - Nothing -> - -- This can occur when we're writing out ifaces for - -- requirements; we didn't do any /real/ typechecking - -- so there's no guarantee everything is loaded. - -- Kind of a heinous hack. - initIfaceLoad hsc_env . withIfaceErr ctx - $ withoutDynamicNow - -- If you try and load interfaces when dynamic-too - -- enabled then it attempts to load the dyn_hi and hi - -- interface files. Backpack doesn't really care about - -- dynamic object files as it isn't doing any code - -- generation so -dynamic-too is turned off. - -- Some tests fail without doing this (such as T16219), - -- but they fail because dyn_hi files are not found for - -- one of the dependencies (because they are deliberately turned off) - -- Why is this check turned off here? That is unclear but - -- just one of the many horrible hacks in the backpack - -- implementation. - $ loadInterface (text "lookupVers2") mod ImportBySystem - return $ snd (mi_hash_fn (mi_final_exts iface) occ `orElse` - pprPanic "lookupVers1" (ppr mod <+> ppr occ)) - - -- | Creates cached lookup for the 'mi_anns' field of ModIface -- Hackily, we use "module" as the OccName for any module-level annotations mkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload] ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -26,20 +26,18 @@ fingerprintBinMem bh = withBinBuffer bh f in fp `seq` return fp computeFingerprint :: (Binary a) - => (BinHandle -> Name -> IO ()) - -> a + => a -> IO Fingerprint -computeFingerprint put_nonbinding_name a = do +computeFingerprint a = do bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block put_ bh a fingerprintBinMem bh where - set_user_data bh = - setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS + set_user_data bh = setWriterUserData bh $ newWriteState putNameLiterally putFS -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -13,9 +13,7 @@ import GHC.Prelude import GHC.Driver.Session import GHC.Driver.Env -import GHC.Utils.Binary import GHC.Unit.Module -import GHC.Types.Name import GHC.Types.SafeHaskell import GHC.Utils.Fingerprint import GHC.Iface.Recomp.Binary @@ -31,10 +29,9 @@ import System.FilePath (normalise) -- NB: The 'Module' parameter is the 'Module' recorded by the *interface* -- file, not the actual 'Module' according to our 'DynFlags'. fingerprintDynFlags :: HscEnv -> Module - -> (BinHandle -> Name -> IO ()) -> IO Fingerprint -fingerprintDynFlags hsc_env this_mod nameio = +fingerprintDynFlags hsc_env this_mod = let dflags at DynFlags{..} = hsc_dflags hsc_env mainis = if mainModIs (hsc_HUE hsc_env) == this_mod then Just mainFunIs else Nothing -- see #5878 @@ -73,7 +70,7 @@ fingerprintDynFlags hsc_env this_mod nameio = flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, codegen, debugLevel, callerCcFilters)) in -- pprTrace "flags" (ppr flags) $ - computeFingerprint nameio flags + computeFingerprint flags -- Fingerprint the optimisation info. We keep this separate from the rest of -- the flags because GHCi users (especially) may wish to ignore changes in @@ -81,9 +78,8 @@ fingerprintDynFlags hsc_env this_mod nameio = -- object files as they can. -- See Note [Ignoring some flag changes] fingerprintOptFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) -> IO Fingerprint -fingerprintOptFlags DynFlags{..} nameio = +fingerprintOptFlags DynFlags{..} = let -- See https://gitlab.haskell.org/ghc/ghc/issues/10923 -- We used to fingerprint the optimisation level, but as Joachim @@ -92,22 +88,21 @@ fingerprintOptFlags DynFlags{..} nameio = opt_flags = map fromEnum $ filter (`EnumSet.member` optimisationFlags) (EnumSet.toList generalFlags) - in computeFingerprint nameio opt_flags + in computeFingerprint opt_flags -- Fingerprint the HPC info. We keep this separate from the rest of -- the flags because GHCi users (especially) may wish to use an object -- file compiled for HPC when not actually using HPC. -- See Note [Ignoring some flag changes] fingerprintHpcFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) -> IO Fingerprint -fingerprintHpcFlags dflags at DynFlags{..} nameio = +fingerprintHpcFlags dflags at DynFlags{..} = let -- -fhpc, see https://gitlab.haskell.org/ghc/ghc/issues/11798 -- hpcDir is output-only, so we should recompile if it changes hpc = if gopt Opt_Hpc dflags then Just hpcDir else Nothing - in computeFingerprint nameio hpc + in computeFingerprint hpc {- Note [path flags and recompilation] ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith, import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Proxy infixl 3 &&& @@ -118,15 +119,15 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = - case getUserData bh of - UserData{ ud_put_binding_name = put_binding_name } -> + case findUserDataWriter Proxy bh of + tbl -> --pprTrace "putIfaceTopBndr" (ppr name) $ - put_binding_name bh name + putEntry tbl bh name data IfaceDecl @@ -585,7 +586,7 @@ ifaceDeclFingerprints hash decl where computeFingerprint' = unsafeDupablePerformIO - . computeFingerprint (panic "ifaceDeclFingerprints") + . computeFingerprint fromIfaceWarnings :: IfaceWarnings -> Warnings GhcRn fromIfaceWarnings = \case @@ -2444,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -9,7 +9,6 @@ This module defines interface types and binders {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE LambdaCase #-} - module GHC.Iface.Type ( IfExtName, IfLclName, @@ -90,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ @@ -2045,11 +2044,12 @@ instance Outputable IfaceCoercion where ppr = pprIfaceCoercion instance Binary IfaceTyCon where - put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i + put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i - get bh = do n <- get bh - i <- get bh - return (IfaceTyCon n i) + get bh = do + n <- get bh + i <- get bh + return (IfaceTyCon n i) instance Binary IfaceTyConSort where put_ bh IfaceNormalTyCon = putByte bh 0 ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -66,6 +66,9 @@ import GHC.Prelude import Control.Monad import Data.Array +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import Data.Char (isSpace) import Data.Int import Data.IntSet (IntSet) import qualified Data.IntSet as IS @@ -75,10 +78,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Word import Data.Semigroup -import qualified Data.ByteString as B -import qualified Data.ByteString.Unsafe as B -import Data.Char (isSpace) -import System.IO +import System.IO import GHC.Settings.Constants (hiVersion) @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -313,15 +313,16 @@ putObject bh mod_name deps os = do -- object in an archive. put_ bh (moduleNameString mod_name) - (bh_fs, _bin_dict, put_dict) <- initFSTable bh + (fs_tbl, fs_writer) <- initFastStringWriterTable + let bh_fs = addWriterToUserData (mkSomeBinaryWriter fs_writer) bh - forwardPut_ bh (const put_dict) $ do + forwardPut_ bh (const (putTable fs_tbl bh_fs)) $ do put_ bh_fs deps -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -329,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -344,15 +345,15 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) - let bh = setUserData bh0 $ noUserData { ud_get_fs = getDictFastString dict } + let bh = setReaderUserData bh0 $ newReadState (panic "No name allowed") (getDictFastString dict) block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -363,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -392,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -408,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -778,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -1010,7 +1010,7 @@ data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple - deriving( Eq, Data ) + deriving( Eq, Data, Ord ) instance Outputable TupleSort where ppr ts = text $ ===================================== compiler/GHC/Types/FieldLabel.hs ===================================== @@ -140,9 +140,8 @@ instance Binary Name => Binary FieldLabel where put_ bh (FieldLabel aa ab ac) = do put_ bh aa put_ bh ab - case getUserData bh of - UserData{ ud_put_binding_name = put_binding_name } -> - put_binding_name bh ac + case findUserDataWriter Proxy bh of + tbl -> putEntry tbl bh ac get bh = do aa <- get bh ab <- get bh ===================================== compiler/GHC/Types/Name.hs ===================================== @@ -663,12 +663,12 @@ instance Data Name where -- distinction. instance Binary Name where put_ bh name = - case getUserData bh of - UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name + case findUserDataWriter Proxy bh of + tbl -> putEntry tbl bh name get bh = - case getUserData bh of - UserData { ud_get_name = get_name } -> get_name bh + case findUserDataReader Proxy bh of + tbl -> getEntry tbl bh {- ************************************************************************ ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -4,6 +4,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-} +{-# LANGUAGE TypeFamilies #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected @@ -21,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -30,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -66,13 +69,26 @@ module GHC.Utils.Binary lazyPutMaybe, -- * User data - UserData(..), getUserData, setUserData, - newReadState, newWriteState, noUserData, - + ReaderUserData(..), getReaderUserData, setReaderUserData, noReaderUserData, + WriterUserData(..), getWriterUserData, setWriterUserData, noWriterUserData, + mkWriterUserData, mkReaderUserData, + newReadState, newWriteState, + addReaderToUserData, addWriterToUserData, + findUserDataReader, findUserDataWriter, + -- * Binary Readers & Writers + BinaryReader(..), BinaryWriter(..), + mkWriter, mkReader, + SomeBinaryReader, SomeBinaryWriter, + mkSomeBinaryReader, mkSomeBinaryWriter, + -- * Tables + SomeReaderTable(..), + ReaderTable(..), + SomeWriterTable(..), + WriterTable(..), -- * String table ("dictionary") + initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, - FSTable, initFSTable, getDictFastString, putDictFastString, - + FSTable(..), getDictFastString, putDictFastString, -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..) ) where @@ -93,6 +109,7 @@ import qualified GHC.Data.Strict as Strict import GHC.Utils.Outputable( JoinPointHood(..) ) import Control.DeepSeq +import Control.Monad ( when, (<$!>), unless, forM_, void ) import Foreign hiding (shiftL, shiftR, void) import Data.Array import Data.Array.IO @@ -104,11 +121,13 @@ import Data.IORef import Data.Char ( ord, chr ) import Data.List.NonEmpty ( NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Data.Set ( Set ) import qualified Data.Set as Set import Data.Time import Data.List (unfoldr) -import Control.Monad ( when, (<$!>), unless, forM_, void ) +import Data.Typeable import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Error ( mkIOError, eofErrorType ) @@ -119,6 +138,8 @@ import qualified Data.IntMap as IntMap import GHC.ForeignPtr ( unsafeWithForeignPtr ) #endif +import Unsafe.Coerce (unsafeCoerce) + type BinArray = ForeignPtr Word8 #if !MIN_VERSION_base(4,15,0) @@ -150,49 +171,83 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_usr :: UserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: !WriterUserData, + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getUserData :: BinHandle -> UserData -getUserData bh = bh_usr bh +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: !ReaderUserData, + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) + } + +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh + +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setUserData :: BinHandle -> UserData -> BinHandle -setUserData bh us = bh { bh_usr = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } + +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } + +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle +addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) + } + } + +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle +addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) + } + } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -211,23 +266,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -235,42 +290,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } + +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -279,20 +349,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -313,7 +386,7 @@ expandBin (BinMem _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -329,7 +402,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -350,8 +423,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -372,39 +445,37 @@ putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -412,7 +483,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -425,7 +496,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -437,7 +508,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -458,10 +529,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -484,15 +555,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -509,15 +580,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -533,15 +604,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -561,15 +632,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -980,63 +1051,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1044,14 +1115,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1062,7 +1133,9 @@ lazyGetMaybe bh = do -- UserData -- ----------------------------------------------------------------------------- --- | Information we keep around during interface file +-- Note [Binary UserData] +-- ~~~~~~~~~~~~~~~~~~~~~~ +-- Information we keep around during interface file -- serialization/deserialization. Namely we keep the functions for serializing -- and deserializing 'Name's and 'FastString's. We do this because we actually -- use serialization in two distinct settings, @@ -1081,73 +1154,188 @@ lazyGetMaybe bh = do -- non-binding Name is serialized as the fingerprint of the thing they -- represent. See Note [Fingerprinting IfaceDecls] for further discussion. -- -data UserData = - UserData { - -- for *deserialising* only: - ud_get_name :: BinHandle -> IO Name, - ud_get_fs :: BinHandle -> IO FastString, - - -- for *serialising* only: - ud_put_nonbinding_name :: BinHandle -> Name -> IO (), - -- ^ serialize a non-binding 'Name' (e.g. a reference to another - -- binding). - ud_put_binding_name :: BinHandle -> Name -> IO (), - -- ^ serialize a binding 'Name' (e.g. the name of an IfaceDecl) - ud_put_fs :: BinHandle -> FastString -> IO () + +-- | Existential for 'BinaryWriter' with a type witness. +data SomeBinaryWriter = forall a . SomeBinaryWriter TypeRep (BinaryWriter a) + +-- | Existential for 'BinaryReader' with a type witness. +data SomeBinaryReader = forall a . SomeBinaryReader TypeRep (BinaryReader a) + +-- | UserData required to serialise symbols for interface files. +-- +-- See Note [Binary UserData] +data WriterUserData = + WriterUserData { + ud_writer_data :: Map TypeRep SomeBinaryWriter + -- ^ A mapping from a type witness to the 'Writer' for the associated type. + -- This is a 'Map' because microbenchmarks indicated this is more efficient + -- than other representations for less than ten elements. + -- + -- Considered representations: + -- + -- * [(TypeRep, SomeBinaryWriter)] + -- * bytehash (on hackage) + -- * Map TypeRep SomeBinaryWriter } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) - -> UserData -newReadState get_name get_fs - = UserData { ud_get_name = get_name, - ud_get_fs = get_fs, - ud_put_nonbinding_name = undef "put_nonbinding_name", - ud_put_binding_name = undef "put_binding_name", - ud_put_fs = undef "put_fs" - } - -newWriteState :: (BinHandle -> Name -> IO ()) - -- ^ how to serialize non-binding 'Name's - -> (BinHandle -> Name -> IO ()) +-- | UserData required to deserialise symbols for interface files. +-- +-- See Note [Binary UserData] +data ReaderUserData = + ReaderUserData { + ud_reader_data :: Map TypeRep SomeBinaryReader + -- ^ A mapping from a type witness to the 'Reader' for the associated type. + -- This is a 'Map' because microbenchmarks indicated this is more efficient + -- than other representations for less than ten elements. + -- + -- Considered representations: + -- + -- * [(TypeRep, SomeBinaryReader)] + -- * bytehash (on hackage) + -- * Map TypeRep SomeBinaryReader + } + +mkWriterUserData :: [SomeBinaryWriter] -> WriterUserData +mkWriterUserData caches = noWriterUserData + { ud_writer_data = Map.fromList $ map (\cache@(SomeBinaryWriter typRep _) -> (typRep, cache)) caches + } + +mkReaderUserData :: [SomeBinaryReader] -> ReaderUserData +mkReaderUserData caches = noReaderUserData + { ud_reader_data = Map.fromList $ map (\cache@(SomeBinaryReader typRep _) -> (typRep, cache)) caches + } + +mkSomeBinaryWriter :: forall a . Typeable a => BinaryWriter a -> SomeBinaryWriter +mkSomeBinaryWriter cb = SomeBinaryWriter (typeRep (Proxy :: Proxy a)) cb + +mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReader +mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb + +data BinaryReader s = BinaryReader + { getEntry :: ReadBinHandle -> IO s + } + +data BinaryWriter s = BinaryWriter + { putEntry :: WriteBinHandle -> s -> IO () + } + +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter f = BinaryWriter + { putEntry = f + } + +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s +mkReader f = BinaryReader + { getEntry = f + } + +findUserDataReader :: forall a . Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a +findUserDataReader query bh = + case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of + Nothing -> panic $ "Failed to find BinaryReader for key " ++ show (typeRep query) + Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> + unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader + +findUserDataWriter :: forall a . Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a +findUserDataWriter query bh = + case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of + Nothing -> panic $ "Failed to find BinaryWriter for key " ++ show (typeRep query) + Just (SomeBinaryWriter _ (writer :: BinaryWriter x)) -> + unsafeCoerce @(BinaryWriter x) @(BinaryWriter a) writer + +noReaderUserData :: ReaderUserData +noReaderUserData = ReaderUserData + { ud_reader_data = Map.empty + } + +noWriterUserData :: WriterUserData +noWriterUserData = WriterUserData + { ud_writer_data = Map.empty + } + +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) + -> ReaderUserData +newReadState get_name get_fs = + mkReaderUserData + [ mkSomeBinaryReader $ mkReader get_name + , mkSomeBinaryReader $ mkReader get_fs + ] + +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) - -> UserData -newWriteState put_nonbinding_name put_binding_name put_fs - = UserData { ud_get_name = undef "get_name", - ud_get_fs = undef "get_fs", - ud_put_nonbinding_name = put_nonbinding_name, - ud_put_binding_name = put_binding_name, - ud_put_fs = put_fs - } - -noUserData :: UserData -noUserData = UserData - { ud_get_name = undef "get_name" - , ud_get_fs = undef "get_fs" - , ud_put_nonbinding_name = undef "put_nonbinding_name" - , ud_put_binding_name = undef "put_binding_name" - , ud_put_fs = undef "put_fs" + -> (WriteBinHandle -> FastString -> IO ()) + -> WriterUserData +newWriteState put_binding_name put_fs = + mkWriterUserData + [ mkSomeBinaryWriter $ mkWriter put_binding_name + , mkSomeBinaryWriter $ mkWriter put_fs + ] + +-- ---------------------------------------------------------------------------- +-- Types for lookup and deduplication tables. +-- ---------------------------------------------------------------------------- + +data SomeReaderTable f = forall a . Typeable a => + SomeReaderTable (f (ReaderTable a)) + +data SomeWriterTable f = forall a . Typeable a => + SomeWriterTable (f (WriterTable, BinaryWriter a)) + +data ReaderTable a = ReaderTable + { getTable :: ReadBinHandle -> IO (SymbolTable a) + , mkReaderFromTable :: SymbolTable a -> BinaryReader a } -undef :: String -> a -undef s = panic ("Binary.UserData: no " ++ s) +data WriterTable = WriterTable + { putTable :: WriteBinHandle -> IO Int + } --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- -type Dictionary = Array Int FastString -- The dictionary - -- Should be 0-indexed +-- | A 'SymbolTable' of 'FastString's. +type Dictionary = SymbolTable FastString -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +initFastStringReaderTable :: IO (ReaderTable FastString) +initFastStringReaderTable = do + return $ + ReaderTable + { getTable = getDictionary + , mkReaderFromTable = \tbl -> mkReader (getDictFastString tbl) + } + +initFastStringWriterTable :: IO (WriterTable, BinaryWriter FastString) +initFastStringWriterTable = do + dict_next_ref <- newFastMutInt 0 + dict_map_ref <- newIORef emptyUFM + let bin_dict = + FSTable + { fs_tab_next = dict_next_ref + , fs_tab_map = dict_map_ref + } + let put_dict bh = do + fs_count <- readFastMutInt dict_next_ref + dict_map <- readIORef dict_map_ref + putDictionary bh fs_count dict_map + pure fs_count + + return + ( WriterTable + { putTable = put_dict + } + , mkWriter $ putDictFastString bin_dict + ) + +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1156,34 +1344,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) - -initFSTable :: BinHandle -> IO (BinHandle, FSTable, IO Int) -initFSTable bh = do - dict_next_ref <- newFastMutInt 0 - dict_map_ref <- newIORef emptyUFM - let bin_dict = FSTable - { fs_tab_next = dict_next_ref - , fs_tab_map = dict_map_ref - } - let put_dict = do - fs_count <- readFastMutInt dict_next_ref - dict_map <- readIORef dict_map_ref - putDictionary bh fs_count dict_map - pure fs_count - - -- BinHandle with FastString writing support - let ud = getUserData bh - let ud_fs = ud { ud_put_fs = putDictFastString bin_dict } - let bh_fs = setUserData bh ud_fs - - return (bh_fs,bin_dict,put_dict) - -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1212,43 +1378,42 @@ data FSTable = FSTable { fs_tab_next :: !FastMutInt -- The next index to use -- The Symbol Table --------------------------------------------------------- --- On disk, the symbol table is an array of IfExtName, when --- reading it in we turn it into a SymbolTable. - -type SymbolTable = Array Int Name +-- | Symbols that are read from disk. +-- The 'SymbolTable' index starts on '0'. +type SymbolTable a = Array Int a --------------------------------------------------------- -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do @@ -1260,12 +1425,12 @@ instance Binary ByteString where instance Binary FastString where put_ bh f = - case getUserData bh of - UserData { ud_put_fs = put_fs } -> put_fs bh f + case findUserDataWriter (Proxy :: Proxy FastString) bh of + tbl -> putEntry tbl bh f get bh = - case getUserData bh of - UserData { ud_get_fs = get_fs } -> get_fs bh + case findUserDataReader (Proxy :: Proxy FastString) bh of + tbl -> getEntry tbl bh deriving instance Binary NonDetFastString deriving instance Binary LexicalFastString ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe +Subproject commit 799390d1c6d59a606c3dd00dea057baa26ed0c2f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/466682d09a3a0ecd1862807b5194e7de3ba01640...d3b37648179355fde9e450a55a56e09bc3a12944 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/466682d09a3a0ecd1862807b5194e7de3ba01640...d3b37648179355fde9e450a55a56e09bc3a12944 You're receiving 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 Apr 2 12:51:14 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 02 Apr 2024 08:51:14 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: clarify Note [Preproccesing invocations] Message-ID: <660bff42ec17_26e1f61ffea0011539@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - 136bd621 by Ben Gamari at 2024-04-02T08:50:27-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - 9aa67c85 by Cheng Shao at 2024-04-02T08:50:27-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - 50ee0828 by Cheng Shao at 2024-04-02T08:50:27-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 4fe0222f by Cheng Shao at 2024-04-02T08:50:27-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 42b70f1f by Cheng Shao at 2024-04-02T08:50:27-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - c1c37c47 by Andrei Borzenkov at 2024-04-02T08:50:28-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - 20 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/Language/Haskell/Syntax/Type.hs - rts/TSANUtils.c - rts/include/Cmm.h - rts/include/rts/TSANUtils.h - rts/include/stg/SMP.h - rts/rts.cabal - testsuite/tests/partial-sigs/should_run/GHCiWildcardKind.stdout - + testsuite/tests/th/T24299.hs - + testsuite/tests/th/T24299.stderr - testsuite/tests/th/all.T Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -339,7 +339,7 @@ flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . f flavour_string Llvm = "llvm" flavour_string Dwarf = "debug_info" flavour_string FullyStatic = "fully_static" - flavour_string ThreadSanitiser = "thread_sanitizer" + flavour_string ThreadSanitiser = "thread_sanitizer_cmm" flavour_string NoSplitSections = "no_split_sections" flavour_string BootNonmovingGc = "boot_nonmoving_gc" @@ -969,9 +969,9 @@ job_groups = , validateBuilds Amd64 (Linux Debian10) nativeInt , validateBuilds Amd64 (Linux Debian10) unreg , fastCI (validateBuilds Amd64 (Linux Debian10) debug) - , -- Nightly allowed to fail: #22520 + , -- More work is needed to address TSAN failures: #22520 modifyNightlyJobs allowFailure - (modifyValidateJobs manual tsan_jobs) + (modifyValidateJobs (allowFailure . manual) tsan_jobs) , -- Nightly allowed to fail: #22343 modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) @@ -1039,7 +1039,7 @@ job_groups = -- Haddock is large enough to make TSAN choke without massive quantities of -- memory. . addVariable "HADRIAN_ARGS" "--docs=none") $ - validateBuilds Amd64 (Linux Debian10) tsan + validateBuilds Amd64 (Linux Debian12) tsan make_wasm_jobs cfg = modifyJobs @@ -1083,6 +1083,7 @@ platform_mapping = Map.map go combined_result , "nightly-x86_64-linux-deb11-validate" , "nightly-x86_64-linux-deb12-validate" , "x86_64-linux-alpine3_18-wasm-cross_wasm32-wasi-release+fully_static" + , "x86_64-linux-deb12-validate+thread_sanitizer_cmm" , "nightly-aarch64-linux-deb10-validate" , "nightly-x86_64-linux-alpine3_12-validate" , "nightly-x86_64-linux-deb10-validate" ===================================== .gitlab/jobs.yaml ===================================== @@ -1644,18 +1644,18 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb10-validate+thread_sanitizer": { + "nightly-x86_64-linux-deb10-zstd-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], - "allow_failure": true, + "allow_failure": false, "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1698,17 +1698,15 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", - "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "HADRIAN_ARGS": "--docs=none", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", - "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", + "TEST_ENV": "x86_64-linux-deb10-zstd-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb10-zstd-validate": { + "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -1719,7 +1717,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", + "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1729,14 +1727,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-deb10-$CACHE_REV", + "key": "x86_64-linux-deb11-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -1762,15 +1760,17 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-zstd-validate", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { + "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -1781,7 +1781,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1823,18 +1823,19 @@ "x86_64-linux" ], "variables": { - "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "BIGNUM_BACKEND": "native", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", - "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", - "CROSS_TARGET": "aarch64-linux-gnu", + "CONFIGURE_WRAPPER": "emconfigure", + "CROSS_EMULATOR": "js-emulator", + "CROSS_TARGET": "javascript-unknown-ghcjs", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { + "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -1845,7 +1846,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", + "ghc-x86_64-linux-deb11-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1887,19 +1888,16 @@ "x86_64-linux" ], "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", + "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-validate": { + "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -1910,7 +1908,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb11-validate.tar.xz", + "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1953,15 +1951,15 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", - "BUILD_FLAVOUR": "validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", + "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-validate", + "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { + "nightly-x86_64-linux-deb12-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -1972,7 +1970,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", + "ghc-x86_64-linux-deb12-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1982,14 +1980,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", + "key": "x86_64-linux-deb12-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2015,15 +2013,15 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", - "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate", + "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", - "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc", + "RUNTEST_ARGS": "", + "TEST_ENV": "x86_64-linux-deb12-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb12-validate": { + "nightly-x86_64-linux-deb12-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -2034,7 +2032,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb12-validate.tar.xz", + "ghc-x86_64-linux-deb12-validate+llvm.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -2077,26 +2075,26 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate", - "BUILD_FLAVOUR": "validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm", + "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb12-validate", + "TEST_ENV": "x86_64-linux-deb12-validate+llvm", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb12-validate+llvm": { + "nightly-x86_64-linux-deb12-validate+thread_sanitizer_cmm": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], - "allow_failure": false, + "allow_failure": true, "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb12-validate+llvm.tar.xz", + "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -2139,11 +2137,13 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm", - "BUILD_FLAVOUR": "validate+llvm", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm", + "BUILD_FLAVOUR": "validate+thread_sanitizer_cmm", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", + "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb12-validate+llvm", + "TEST_ENV": "x86_64-linux-deb12-validate+thread_sanitizer_cmm", + "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" } }, @@ -5090,7 +5090,7 @@ "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, - "x86_64-linux-deb10-validate+thread_sanitizer": { + "x86_64-linux-deb10-zstd-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -5101,7 +5101,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5127,9 +5127,8 @@ ], "rules": [ { - "allow_failure": true, - "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", - "when": "manual" + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "when": "on_success" } ], "script": [ @@ -5145,16 +5144,14 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", - "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "HADRIAN_ARGS": "--docs=none", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", - "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" + "TEST_ENV": "x86_64-linux-deb10-zstd-validate" } }, - "x86_64-linux-deb10-zstd-validate": { + "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -5165,7 +5162,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", + "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5175,14 +5172,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-deb10-$CACHE_REV", + "key": "x86_64-linux-deb11-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -5191,7 +5188,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -5208,14 +5205,16 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-zstd-validate" + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, - "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { + "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -5226,7 +5225,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5252,7 +5251,7 @@ ], "rules": [ { - "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*javascript.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -5268,17 +5267,18 @@ "x86_64-linux" ], "variables": { - "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "BIGNUM_BACKEND": "native", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", - "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", - "CROSS_TARGET": "aarch64-linux-gnu", + "CONFIGURE_WRAPPER": "emconfigure", + "CROSS_EMULATOR": "js-emulator", + "CROSS_TARGET": "javascript-unknown-ghcjs", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" + "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, - "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { + "x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -5289,7 +5289,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", + "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5315,7 +5315,7 @@ ], "rules": [ { - "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*javascript.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -5331,18 +5331,15 @@ "x86_64-linux" ], "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", - "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", + "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", + "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc" } }, - "x86_64-linux-deb11-validate+boot_nonmoving_gc": { + "x86_64-linux-deb12-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -5353,7 +5350,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", + "ghc-x86_64-linux-deb12-validate+llvm.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5363,14 +5360,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", + "key": "x86_64-linux-deb12-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -5379,7 +5376,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -5396,25 +5393,25 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", - "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm", + "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", - "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc" + "RUNTEST_ARGS": "", + "TEST_ENV": "x86_64-linux-deb12-validate+llvm" } }, - "x86_64-linux-deb12-validate+llvm": { + "x86_64-linux-deb12-validate+thread_sanitizer_cmm": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], - "allow_failure": false, + "allow_failure": true, "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb12-validate+llvm.tar.xz", + "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5440,8 +5437,9 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", - "when": "on_success" + "allow_failure": true, + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "when": "manual" } ], "script": [ @@ -5457,11 +5455,13 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm", - "BUILD_FLAVOUR": "validate+llvm", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm", + "BUILD_FLAVOUR": "validate+thread_sanitizer_cmm", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", + "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb12-validate+llvm" + "TEST_ENV": "x86_64-linux-deb12-validate+thread_sanitizer_cmm", + "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, "x86_64-linux-fedora33-release": { ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -184,7 +184,7 @@ saveRestoreCallerRegs us platform = restore = blockFromList restore_nodes -- | Mirrors __tsan_memory_order --- +-- memoryOrderToTsanMemoryOrder :: Env -> MemoryOrdering -> CmmExpr memoryOrderToTsanMemoryOrder env mord = mkIntExpr (platform env) n @@ -294,4 +294,3 @@ tsanAtomicRMW env mord op w addr val dest = AMO_Or -> "fetch_or" AMO_Xor -> "fetch_xor" fn = fsLit $ "__tsan_atomic" ++ show (widthInBits w) ++ "_" ++ op' - ===================================== compiler/GHC/Rename/Splice.hs ===================================== @@ -677,7 +677,7 @@ References: [2] 'rnSpliceExpr' [3] 'GHC.Tc.Gen.Splice.qAddModFinalizer' [4] 'GHC.Tc.Gen.Expr.tcExpr' ('HsSpliceE' ('HsSpliced' ...)) -[5] 'GHC.Tc.Gen.HsType.tc_hs_type' ('HsSpliceTy' ('HsSpliced' ...)) +[5] 'GHC.Tc.Gen.HsType.tcHsType' ('HsSpliceTy' ('HsSpliced' ...)) [6] 'GHC.Tc.Gen.Pat.tc_pat' ('SplicePat' ('HsSpliced' ...)) -} ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -63,7 +63,22 @@ underlying program (the C compiler), the set of flags passed determines the behaviour of the preprocessor, and Cpp and HsCpp behave differently. Specifically, we rely on "traditional" (pre-standard) preprocessing semantics (which most compilers expose via the `-traditional` flag) when preprocessing -Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +Haskell source. This avoids the following situations: + + * Removal of C-style comments, which are not comments in Haskell but valid + operators; + + * Errors due to an ANSI C preprocessor lexing the source and failing on + names with single quotes (TH quotes, ticked promoted constructors, + names with primes in them). + + Both of those cases may be subtle: gcc and clang permit C++-style // + comments in C code, and Data.Array and Data.Vector both export a // + operator whose type is such that a removed "comment" may leave code that + typechecks but does the wrong thing. Another example is that, since ANSI + C permits long character constants, an expression involving multiple + functions with primes in their names may not expand macros properly when + they occur between the primed functions. -} -- | Run either the Haskell preprocessor or the C preprocessor, as per the ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -1678,7 +1678,7 @@ tcRhs (TcPatBind infos pat' mult mult_ann grhss pat_ty) -- is generated so that multiplicity can be inferred. tcMultAnn :: HsMultAnn GhcRn -> TcM Mult tcMultAnn (HsPct1Ann _) = return oneDataConTy -tcMultAnn (HsMultAnn _ p) = tcCheckLHsType p (TheKind multiplicityTy) +tcMultAnn (HsMultAnn _ p) = tcCheckLHsTypeInContext p (TheKind multiplicityTy) tcMultAnn (HsNoMultAnn _) = newFlexiTyVarTy multiplicityTy tcExtendTyVarEnvForRhs :: Maybe TcIdSigInst -> TcM a -> TcM a ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -56,7 +56,7 @@ module GHC.Tc.Gen.HsType ( tcHsLiftedType, tcHsOpenType, tcHsLiftedTypeNC, tcHsOpenTypeNC, tcInferLHsType, tcInferLHsTypeKind, tcInferLHsTypeUnsaturated, - tcCheckLHsType, + tcCheckLHsTypeInContext, tcHsContext, tcLHsPredType, kindGeneralizeAll, @@ -397,7 +397,7 @@ kcClassSigType names sig_ty@(L _ (HsSig { sig_bndrs = hs_outer_bndrs, sig_body = hs_ty })) = addSigCtxt (funsSigCtxt names) sig_ty $ do { _ <- bindOuterSigTKBndrs_Tv hs_outer_bndrs $ - tcLHsType hs_ty liftedTypeKind + tcCheckLHsType hs_ty liftedTypeKind ; return () } tcClassSigType :: [LocatedN Name] -> LHsSigType GhcRn -> TcM Type @@ -467,7 +467,7 @@ tc_lhs_sig_type skol_info full_hs_ty@(L loc (HsSig { sig_bndrs = hs_outer_bndrs do { exp_kind <- newExpectedKind ctxt_kind -- See Note [Escaping kind in type signatures] ; stuff <- tcOuterTKBndrs skol_info hs_outer_bndrs $ - tcLHsType hs_ty exp_kind + tcCheckLHsType hs_ty exp_kind ; return (exp_kind, stuff) } -- Default any unconstrained variables free in the kind @@ -609,7 +609,7 @@ tc_top_lhs_type tyki ctxt (L loc sig_ty@(HsSig { sig_bndrs = hs_outer_bndrs <- pushLevelAndSolveEqualitiesX "tc_top_lhs_type" $ tcOuterTKBndrs skol_info hs_outer_bndrs $ do { kind <- newExpectedKind (expectedKindInCtxt ctxt) - ; tc_lhs_type (mkMode tyki) body kind } + ; tc_check_lhs_type (mkMode tyki) body kind } ; outer_bndrs <- scopedSortOuter outer_bndrs ; let outer_tv_bndrs = outerTyVarBndrs outer_bndrs @@ -704,7 +704,7 @@ tcHsTypeApp wc_ty kind -- We are looking at a user-written type, very like a -- signature so we want to solve its equalities right now bindNamedWildCardBinders sig_wcs $ \ _ -> - tc_lhs_type mode hs_ty kind + tc_check_lhs_type mode hs_ty kind -- We do not kind-generalize type applications: we just -- instantiate with exactly what the user says. @@ -720,7 +720,7 @@ tcHsTypeApp wc_ty kind ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A HsWildCardBndrs's hswc_ext now only includes /named/ wildcards, so any unnamed wildcards stay unchanged in hswc_body. When called in -tcHsTypeApp, tcCheckLHsType will call emitAnonTypeHole +tcHsTypeApp, tcCheckLHsTypeInContext will call emitAnonTypeHole on these anonymous wildcards. However, this would trigger error/warning when an anonymous wildcard is passed in as a visible type argument, which we do not want because users should be able to write @@ -790,10 +790,10 @@ We work this out in a hacky way, by looking at the expected kind: see Note [Inferring tuple kinds]. In this case, we kind-check the RHS using the kind gotten from the LHS: -see the call to tcCheckLHsType in tcTyFamInstEqnGuts in GHC.Tc.Tycl. +see the call to tcCheckLHsTypeInContext in tcTyFamInstEqnGuts in GHC.Tc.Tycl. But we want the kind from the LHS to be /zonked/, so that when -kind-checking the RHS (tcCheckLHsType) we can "see" what we learned +kind-checking the RHS (tcCheckLHsTypeInContext) we can "see" what we learned from kind-checking the LHS (tcFamTyPats). In our example above, the type of the LHS is just `kappa` (by instantiating the forall k), but then we learn (from x::Constraint) that kappa ~ Constraint. We want @@ -821,15 +821,15 @@ tcHsOpenType, tcHsLiftedType, tcHsOpenType hs_ty = addTypeCtxt hs_ty $ tcHsOpenTypeNC hs_ty tcHsLiftedType hs_ty = addTypeCtxt hs_ty $ tcHsLiftedTypeNC hs_ty -tcHsOpenTypeNC hs_ty = do { ek <- newOpenTypeKind; tcLHsType hs_ty ek } -tcHsLiftedTypeNC hs_ty = tcLHsType hs_ty liftedTypeKind +tcHsOpenTypeNC hs_ty = do { ek <- newOpenTypeKind; tcCheckLHsType hs_ty ek } +tcHsLiftedTypeNC hs_ty = tcCheckLHsType hs_ty liftedTypeKind --- Like tcHsType, but takes an expected kind -tcCheckLHsType :: LHsType GhcRn -> ContextKind -> TcM TcType -tcCheckLHsType hs_ty exp_kind +-- Like tcCheckLHsType, but takes an expected kind +tcCheckLHsTypeInContext :: LHsType GhcRn -> ContextKind -> TcM TcType +tcCheckLHsTypeInContext hs_ty exp_kind = addTypeCtxt hs_ty $ do { ek <- newExpectedKind exp_kind - ; tcLHsType hs_ty ek } + ; tcCheckLHsType hs_ty ek } tcInferLHsType :: LHsType GhcRn -> TcM TcType tcInferLHsType hs_ty @@ -854,7 +854,7 @@ tcInferLHsTypeUnsaturated :: LHsType GhcRn -> TcM (TcType, TcKind) tcInferLHsTypeUnsaturated hs_ty = addTypeCtxt hs_ty $ do { mode <- mkHoleMode TypeLevel HM_Sig -- Allow and report holes - ; case splitHsAppTys (unLoc hs_ty) of + ; case splitHsAppTys_maybe (unLoc hs_ty) of Just (hs_fun_ty, hs_args) -> do { (fun_ty, _ki) <- tcInferTyAppHead mode hs_fun_ty ; tcInferTyApps_nosat mode hs_fun_ty fun_ty hs_args } @@ -890,12 +890,18 @@ Terms are eagerly instantiated. This means that if you say x = id then `id` gets instantiated to have type alpha -> alpha. The variable -alpha is then unconstrained and regeneralized. But we cannot do this -in types, as we have no type-level lambda. So, when we are sure -that we will not want to regeneralize later -- because we are done -checking a type, for example -- we can instantiate. But we do not -instantiate at variables, nor do we in tcInferLHsTypeUnsaturated, -which is used by :kind in GHCi. +alpha is then unconstrained and regeneralized. So we may well end up with + x = /\x. id @a +But we cannot do this in types, as we have no type-level lambda. + +So, we must be careful only to instantiate at the last possible moment, when +we're sure we're never going to want the lost polymorphism again. This is done +in calls to `tcInstInvisibleTyBinders`; a particular case in point is in +`checkExpectedKind`. + +Otherwise, we are careful /not/ to instantiate. For example: +* at a variable in `tcTyVar` +* in `tcInferLHsTypeUnsaturated`, which is used by :kind in GHCi. ************************************************************************ * * @@ -969,48 +975,18 @@ instance Outputable TcTyMode where {- Note [Bidirectional type checking] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In expressions, whenever we see a polymorphic identifier, say `id`, we are -free to instantiate it with metavariables, knowing that we can always -re-generalize with type-lambdas when necessary. For example: - - rank2 :: (forall a. a -> a) -> () - x = rank2 id - -When checking the body of `x`, we can instantiate `id` with a metavariable. -Then, when we're checking the application of `rank2`, we notice that we really -need a polymorphic `id`, and then re-generalize over the unconstrained -metavariable. - -In types, however, we're not so lucky, because *we cannot re-generalize*! -There is no lambda. So, we must be careful only to instantiate at the last -possible moment, when we're sure we're never going to want the lost polymorphism -again. This is done in calls to tcInstInvisibleTyBinders. - -To implement this behavior, we use bidirectional type checking, where we -explicitly think about whether we know the kind of the type we're checking -or not. Note that there is a difference between not knowing a kind and -knowing a metavariable kind: the metavariables are TauTvs, and cannot become -forall-quantified kinds. Previously (before dependent types), there were -no higher-rank kinds, and so we could instantiate early and be sure that -no types would have polymorphic kinds, and so we could always assume that -the kind of a type was a fresh metavariable. Not so anymore, thus the -need for two algorithms. - -For HsType forms that can never be kind-polymorphic, we implement only the -"down" direction, where we safely assume a metavariable kind. For HsType forms -that *can* be kind-polymorphic, we implement just the "up" (functions with -"infer" in their name) version, as we gain nothing by also implementing the -"down" version. - -Note [Future-proofing the type checker] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As discussed in Note [Bidirectional type checking], each HsType form is -handled in *either* tc_infer_hs_type *or* tc_hs_type. These functions -are mutually recursive, so that either one can work for any type former. -But, we want to make sure that our pattern-matches are complete. So, -we have a bunch of repetitive code just so that we get warnings if we're -missing any patterns. +In types, as in terms, we use bidirectional type infefence. The main workhorse +function looks like this: + type ExpKind = ExpType + data ExpType = Check TcSigmaKind | Infer ...(hole TcRhoType)... + + tcHsType :: TcTyMode -> HsType GhcRn -> ExpKind -> TcM TcType + +* When the `ExpKind` argument is (Check ki), we /check/ that the type has + kind `ki` +* When the `ExpKind` argument is (Infer hole), we /infer/ the kind of the + type, and fill the hole with that kind -} ------------------------------------------ @@ -1022,74 +998,13 @@ tc_infer_lhs_type mode (L span ty) = setSrcSpanA span $ tc_infer_hs_type mode ty ---------------------------- --- | Call 'tc_infer_hs_type' and check its result against an expected kind. -tc_infer_hs_type_ek :: HasDebugCallStack => TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType -tc_infer_hs_type_ek mode hs_ty ek - = do { (ty, k) <- tc_infer_hs_type mode hs_ty - ; checkExpectedKind hs_ty ty k ek } - --------------------------- -- | Infer the kind of a type and desugar. This is the "up" type-checker, -- as described in Note [Bidirectional type checking] tc_infer_hs_type :: TcTyMode -> HsType GhcRn -> TcM (TcType, TcKind) -tc_infer_hs_type mode (HsParTy _ t) - = tc_infer_lhs_type mode t - -tc_infer_hs_type mode ty - | Just (hs_fun_ty, hs_args) <- splitHsAppTys ty - = do { (fun_ty, _ki) <- tcInferTyAppHead mode hs_fun_ty - ; tcInferTyApps mode hs_fun_ty fun_ty hs_args } - -tc_infer_hs_type mode (HsKindSig _ ty sig) - = do { let mode' = mode { mode_tyki = KindLevel } - ; sig' <- tc_lhs_kind_sig mode' KindSigCtxt sig - -- We must typecheck the kind signature, and solve all - -- its equalities etc; from this point on we may do - -- things like instantiate its foralls, so it needs - -- to be fully determined (#14904) - ; traceTc "tc_infer_hs_type:sig" (ppr ty $$ ppr 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 --- the splice location to the typechecker. Here we skip over it in order to have --- the same kind inferred for a given expression whether it was produced from --- splices or not. --- --- See Note [Delaying modFinalizers in untyped splices]. -tc_infer_hs_type mode (HsSpliceTy (HsUntypedSpliceTop _ ty) _) - = tc_infer_lhs_type mode ty - -tc_infer_hs_type _ (HsSpliceTy (HsUntypedSpliceNested n) s) = pprPanic "tc_infer_hs_type: invalid nested splice" (pprUntypedSplice True (Just n) s) - -tc_infer_hs_type mode (HsDocTy _ ty _) = tc_infer_lhs_type mode ty - --- See Note [Typechecking HsCoreTys] -tc_infer_hs_type _ (XHsType ty) - = do env <- getLclEnv - -- Raw uniques since we go from NameEnv to TvSubstEnv. - let subst_prs :: [(Unique, TcTyVar)] - subst_prs = [ (getUnique nm, tv) - | ATyVar nm tv <- nonDetNameEnvElts (getLclEnvTypeEnv env) ] - subst = mkTvSubst - (mkInScopeSetList $ map snd subst_prs) - (listToUFM_Directly $ map (fmap mkTyVarTy) subst_prs) - ty' = substTy subst ty - return (ty', typeKind ty') - -tc_infer_hs_type _ (HsExplicitListTy _ _ tys) - | null tys -- this is so that we can use visible kind application with '[] - -- e.g ... '[] @Bool - = return (mkTyConTy promotedNilDataCon, - mkSpecForAllTys [alphaTyVar] $ mkListTy alphaTy) - -tc_infer_hs_type mode other_ty - = do { kv <- newMetaKindVar - ; ty' <- tc_hs_type mode other_ty kv - ; return (ty', kv) } +tc_infer_hs_type mode rn_ty + = tcInfer $ \exp_kind -> tcHsType mode rn_ty exp_kind {- Note [Typechecking HsCoreTys] @@ -1133,26 +1048,36 @@ substitution to each HsCoreTy and all is well: -} ------------------------------------------ -tcLHsType :: LHsType GhcRn -> TcKind -> TcM TcType -tcLHsType hs_ty exp_kind - = tc_lhs_type typeLevelMode hs_ty exp_kind +tcCheckLHsType :: LHsType GhcRn -> TcKind -> TcM TcType +tcCheckLHsType hs_ty exp_kind + = tc_check_lhs_type typeLevelMode hs_ty exp_kind + +tc_check_lhs_type :: TcTyMode -> LHsType GhcRn -> TcKind -> TcM TcType +tc_check_lhs_type mode (L span ty) exp_kind + = setSrcSpanA span $ + tc_check_hs_type mode ty exp_kind -tc_lhs_type :: TcTyMode -> LHsType GhcRn -> TcKind -> TcM TcType -tc_lhs_type mode (L span ty) exp_kind +tc_check_hs_type :: TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType +-- See Note [Bidirectional type checking] +tc_check_hs_type mode ty ek = tcHsType mode ty (Check ek) + +tcLHsType :: TcTyMode -> LHsType GhcRn -> ExpKind -> TcM TcType +tcLHsType mode (L span ty) exp_kind = setSrcSpanA span $ - tc_hs_type mode ty exp_kind + tcHsType mode ty exp_kind -tc_hs_type :: TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType +tcHsType :: TcTyMode -> HsType GhcRn -> ExpKind -> TcM TcType +-- The main workhorse for type kind checking -- See Note [Bidirectional type checking] -tc_hs_type mode (HsParTy _ ty) exp_kind = tc_lhs_type mode ty exp_kind -tc_hs_type mode (HsDocTy _ ty _) exp_kind = tc_lhs_type mode ty exp_kind -tc_hs_type _ ty@(HsBangTy _ bang _) _ +tcHsType mode (HsParTy _ ty) exp_kind = tcLHsType mode ty exp_kind +tcHsType mode (HsDocTy _ ty _) exp_kind = tcLHsType mode ty exp_kind +tcHsType _ ty@(HsBangTy _ bang _) _ -- While top-level bangs at this point are eliminated (eg !(Maybe Int)), -- other kinds of bangs are not (eg ((!Maybe) Int)). These kinds of -- bangs are invalid, so fail. (#7210, #14761) = failWith $ TcRnUnexpectedAnnotation ty bang -tc_hs_type _ ty@(HsRecTy {}) _ +tcHsType _ ty@(HsRecTy {}) _ -- Record types (which only show up temporarily in constructor -- signatures) should have been removed by now = failWithTc $ TcRnIllegalRecordSyntax (Right ty) @@ -1162,23 +1087,23 @@ tc_hs_type _ ty@(HsRecTy {}) _ -- while capturing the local environment. -- -- See Note [Delaying modFinalizers in untyped splices]. -tc_hs_type mode (HsSpliceTy (HsUntypedSpliceTop mod_finalizers ty) _) +tcHsType mode (HsSpliceTy (HsUntypedSpliceTop mod_finalizers ty) _) exp_kind = do addModFinalizersWithLclEnv mod_finalizers - tc_lhs_type mode ty exp_kind + tcLHsType mode ty exp_kind -tc_hs_type _ (HsSpliceTy (HsUntypedSpliceNested n) s) _ = pprPanic "tc_hs_type: invalid nested splice" (pprUntypedSplice True (Just n) s) +tcHsType _ (HsSpliceTy (HsUntypedSpliceNested n) s) _ = pprPanic "tcHsType: invalid nested splice" (pprUntypedSplice True (Just n) s) ---------- Functions and applications -tc_hs_type mode (HsFunTy _ mult ty1 ty2) exp_kind +tcHsType mode (HsFunTy _ mult ty1 ty2) exp_kind = tc_fun_type mode mult ty1 ty2 exp_kind -tc_hs_type mode (HsOpTy _ _ ty1 (L _ op) ty2) exp_kind +tcHsType mode (HsOpTy _ _ ty1 (L _ op) ty2) exp_kind | op `hasKey` unrestrictedFunTyConKey = tc_fun_type mode (HsUnrestrictedArrow noExtField) ty1 ty2 exp_kind --------- Foralls -tc_hs_type mode t@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind +tcHsType mode t@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind | HsForAllInvis{} <- tele = tc_hs_forall_ty tele ty exp_kind -- For an invisible forall, we allow the body to have @@ -1187,15 +1112,15 @@ tc_hs_type mode t@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind | HsForAllVis{} <- tele = do { ek <- newOpenTypeKind - ; r <- tc_hs_forall_ty tele ty ek - ; checkExpectedKind t r ek exp_kind } + ; r <- tc_hs_forall_ty tele ty (Check ek) + ; checkExpKind t r ek exp_kind } -- For a visible forall, we require that the body is of kind TYPE r. -- See Note [Body kind of a HsForAllTy] where tc_hs_forall_ty tele ty ek = do { (tv_bndrs, ty') <- tcTKTelescope mode tele $ - tc_lhs_type mode ty ek + tcLHsType mode ty ek -- Pass on the mode from the type, to any wildcards -- in kind signatures on the forall'd variables -- e.g. f :: _ -> Int -> forall (a :: _). blah @@ -1203,145 +1128,196 @@ tc_hs_type mode t@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind -- Do not kind-generalise here! See Note [Kind generalisation] ; return (mkForAllTys tv_bndrs ty') } -tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind +tcHsType mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind | null (unLoc ctxt) - = tc_lhs_type mode rn_ty exp_kind - - -- See Note [Body kind of a HsQualTy] - | isConstraintLikeKind exp_kind + = tcLHsType mode rn_ty exp_kind + -- See Note [Body kind of a HsQualTy] + | Check kind <- exp_kind, isConstraintLikeKind kind = do { ctxt' <- tc_hs_context mode ctxt - ; ty' <- tc_lhs_type mode rn_ty constraintKind - ; return (tcMkDFunPhiTy ctxt' ty') } + ; ty' <- tc_check_lhs_type mode rn_ty constraintKind + ; return (tcMkDFunPhiTy ctxt' ty') } | otherwise = do { ctxt' <- tc_hs_context mode ctxt - ; ek <- newOpenTypeKind -- The body kind (result of the function) can + ; ek <- newOpenTypeKind -- The body kind (result of the function) can -- be TYPE r, for any r, hence newOpenTypeKind - ; ty' <- tc_lhs_type mode rn_ty ek - ; checkExpectedKind (unLoc rn_ty) (tcMkPhiTy ctxt' ty') - liftedTypeKind exp_kind } + ; ty' <- tc_check_lhs_type mode rn_ty ek + ; let res_ty = tcMkPhiTy ctxt' ty' + ; checkExpKind (unLoc rn_ty) res_ty + liftedTypeKind exp_kind } --------- Lists, arrays, and tuples -tc_hs_type mode rn_ty@(HsListTy _ elt_ty) exp_kind - = do { tau_ty <- tc_lhs_type mode elt_ty liftedTypeKind +tcHsType mode rn_ty@(HsListTy _ elt_ty) exp_kind + = do { tau_ty <- tc_check_lhs_type mode elt_ty liftedTypeKind ; checkWiredInTyCon listTyCon - ; checkExpectedKind rn_ty (mkListTy tau_ty) liftedTypeKind exp_kind } + ; checkExpKind rn_ty (mkListTy tau_ty) liftedTypeKind exp_kind } --- See Note [Distinguishing tuple kinds] in Language.Haskell.Syntax.Type --- See Note [Inferring tuple kinds] -tc_hs_type mode rn_ty@(HsTupleTy _ HsBoxedOrConstraintTuple hs_tys) exp_kind - -- (NB: not zonking before looking at exp_k, to avoid left-right bias) - | Just tup_sort <- tupKindSort_maybe exp_kind - = traceTc "tc_hs_type tuple" (ppr hs_tys) >> - tc_tuple rn_ty mode tup_sort hs_tys exp_kind - | otherwise - = do { traceTc "tc_hs_type tuple 2" (ppr hs_tys) - ; (tys, kinds) <- mapAndUnzipM (tc_infer_lhs_type mode) hs_tys - ; kinds <- liftZonkM $ mapM zonkTcType kinds - -- Infer each arg type separately, because errors can be - -- confusing if we give them a shared kind. Eg #7410 - -- (Either Int, Int), we do not want to get an error saying - -- "the second argument of a tuple should have kind *->*" +tcHsType mode rn_ty@(HsTupleTy _ tup_sort tys) exp_kind + = do k <- expTypeToType exp_kind + tc_hs_tuple_ty rn_ty mode tup_sort tys k - ; let (arg_kind, tup_sort) - = case [ (k,s) | k <- kinds - , Just s <- [tupKindSort_maybe k] ] of - ((k,s) : _) -> (k,s) - [] -> (liftedTypeKind, BoxedTuple) - -- In the [] case, it's not clear what the kind is, so guess * - - ; tys' <- sequence [ setSrcSpanA loc $ - checkExpectedKind hs_ty ty kind arg_kind - | ((L loc hs_ty),ty,kind) <- zip3 hs_tys tys kinds ] - - ; finish_tuple rn_ty tup_sort tys' (map (const arg_kind) tys') exp_kind } - - -tc_hs_type mode rn_ty@(HsTupleTy _ HsUnboxedTuple tys) exp_kind - = tc_tuple rn_ty mode UnboxedTuple tys exp_kind - -tc_hs_type mode rn_ty@(HsSumTy _ hs_tys) exp_kind +tcHsType mode rn_ty@(HsSumTy _ hs_tys) exp_kind = do { let arity = length hs_tys ; arg_kinds <- mapM (\_ -> newOpenTypeKind) hs_tys - ; tau_tys <- zipWithM (tc_lhs_type mode) hs_tys arg_kinds + ; tau_tys <- zipWithM (tc_check_lhs_type mode) hs_tys arg_kinds ; let arg_reps = map kindRep arg_kinds arg_tys = arg_reps ++ tau_tys sum_ty = mkTyConApp (sumTyCon arity) arg_tys sum_kind = unboxedSumKind arg_reps - ; checkExpectedKind rn_ty sum_ty sum_kind exp_kind + ; checkExpKind rn_ty sum_ty sum_kind exp_kind } --------- Promoted lists and tuples -tc_hs_type mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind - -- The '[] case is handled in tc_infer_hs_type. - -- See Note [Future-proofing the type checker]. +tcHsType mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind + -- See Note [Kind-checking explicit lists] + | null tys - = tc_infer_hs_type_ek mode rn_ty exp_kind + = do let ty = mkTyConTy promotedNilDataCon + let kind = mkSpecForAllTys [alphaTyVar] $ mkListTy alphaTy + checkExpKind rn_ty ty kind exp_kind | otherwise = do { tks <- mapM (tc_infer_lhs_type mode) tys ; (taus', kind) <- unifyKinds tys tks ; let ty = (foldr (mk_cons kind) (mk_nil kind) taus') - ; checkExpectedKind rn_ty ty (mkListTy kind) exp_kind } + ; checkExpKind rn_ty ty (mkListTy kind) exp_kind } where mk_cons k a b = mkTyConApp (promoteDataCon consDataCon) [k, a, b] mk_nil k = mkTyConApp (promoteDataCon nilDataCon) [k] -tc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind +tcHsType mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind -- using newMetaKindVar means that we force instantiations of any polykinded -- types. At first, I just used tc_infer_lhs_type, but that led to #11255. = do { ks <- replicateM arity newMetaKindVar - ; taus <- zipWithM (tc_lhs_type mode) tys ks + ; taus <- zipWithM (tc_check_lhs_type mode) tys ks ; let kind_con = tupleTyCon Boxed arity ty_con = promotedTupleDataCon Boxed arity tup_k = mkTyConApp kind_con ks ; checkTupSize arity - ; checkExpectedKind rn_ty (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind } + ; checkExpKind rn_ty (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind } where arity = length tys --------- Constraint types -tc_hs_type mode rn_ty@(HsIParamTy _ (L _ n) ty) exp_kind +tcHsType mode rn_ty@(HsIParamTy _ (L _ n) ty) exp_kind = do { massert (isTypeLevel (mode_tyki mode)) - ; ty' <- tc_lhs_type mode ty liftedTypeKind + ; ty' <- tc_check_lhs_type mode ty liftedTypeKind ; let n' = mkStrLitTy $ hsIPNameFS n ; ipClass <- tcLookupClass ipClassName - ; checkExpectedKind rn_ty (mkClassPred ipClass [n',ty']) + ; checkExpKind rn_ty (mkClassPred ipClass [n',ty']) constraintKind exp_kind } -tc_hs_type _ rn_ty@(HsStarTy _ _) exp_kind +tcHsType _ rn_ty@(HsStarTy _ _) exp_kind -- Desugaring 'HsStarTy' to 'Data.Kind.Type' here means that we don't -- have to handle it in 'coreView' - = checkExpectedKind rn_ty liftedTypeKind liftedTypeKind exp_kind + = checkExpKind rn_ty liftedTypeKind liftedTypeKind exp_kind --------- Literals -tc_hs_type _ rn_ty@(HsTyLit _ (HsNumTy _ n)) exp_kind +tcHsType _ rn_ty@(HsTyLit _ (HsNumTy _ n)) exp_kind = do { checkWiredInTyCon naturalTyCon - ; checkExpectedKind rn_ty (mkNumLitTy n) naturalTy exp_kind } + ; checkExpKind rn_ty (mkNumLitTy n) naturalTy exp_kind } -tc_hs_type _ rn_ty@(HsTyLit _ (HsStrTy _ s)) exp_kind +tcHsType _ rn_ty@(HsTyLit _ (HsStrTy _ s)) exp_kind = do { checkWiredInTyCon typeSymbolKindCon - ; checkExpectedKind rn_ty (mkStrLitTy s) typeSymbolKind exp_kind } -tc_hs_type _ rn_ty@(HsTyLit _ (HsCharTy _ c)) exp_kind + ; checkExpKind rn_ty (mkStrLitTy s) typeSymbolKind exp_kind } +tcHsType _ rn_ty@(HsTyLit _ (HsCharTy _ c)) exp_kind = do { checkWiredInTyCon charTyCon - ; checkExpectedKind rn_ty (mkCharLitTy c) charTy exp_kind } + ; checkExpKind rn_ty (mkCharLitTy c) charTy exp_kind } --------- Wildcards -tc_hs_type mode ty@(HsWildCardTy _) ek - = tcAnonWildCardOcc NoExtraConstraint mode ty ek +tcHsType mode ty@(HsWildCardTy _) ek + = do k <- expTypeToType ek + tcAnonWildCardOcc NoExtraConstraint mode ty k + +--------- Type applications +tcHsType mode rn_ty@(HsTyVar{}) exp_kind = tc_app_ty mode rn_ty exp_kind +tcHsType mode rn_ty@(HsAppTy{}) exp_kind = tc_app_ty mode rn_ty exp_kind +tcHsType mode rn_ty@(HsAppKindTy{}) exp_kind = tc_app_ty mode rn_ty exp_kind +tcHsType mode rn_ty@(HsOpTy{}) exp_kind = tc_app_ty mode rn_ty exp_kind + +tcHsType mode rn_ty@(HsKindSig _ ty sig) exp_kind + = do { let mode' = mode { mode_tyki = KindLevel } + ; sig' <- tc_lhs_kind_sig mode' KindSigCtxt sig + -- We must typecheck the kind signature, and solve all + -- its equalities etc; from this point on we may do + -- things like instantiate its foralls, so it needs + -- to be fully determined (#14904) + ; traceTc "tcHsType:sig" (ppr ty $$ ppr sig') + ; ty' <- tcAddKindSigPlaceholders sig $ + tc_check_lhs_type mode ty sig' + ; checkExpKind rn_ty ty' sig' exp_kind } + +-- See Note [Typechecking HsCoreTys] +tcHsType _ rn_ty@(XHsType ty) exp_kind + = do env <- getLclEnv + -- Raw uniques since we go from NameEnv to TvSubstEnv. + let subst_prs :: [(Unique, TcTyVar)] + subst_prs = [ (getUnique nm, tv) + | ATyVar nm tv <- nonDetNameEnvElts (getLclEnvTypeEnv env) ] + subst = mkTvSubst + (mkInScopeSetList $ map snd subst_prs) + (listToUFM_Directly $ map (fmap mkTyVarTy) subst_prs) + ty' = substTy subst ty + checkExpKind rn_ty ty' (typeKind ty') exp_kind + +tc_hs_tuple_ty :: HsType GhcRn + -> TcTyMode + -> HsTupleSort + -> [LHsType GhcRn] + -> TcKind + -> TcM TcType +-- See Note [Distinguishing tuple kinds] in GHC.Hs.Type +-- See Note [Inferring tuple kinds] +tc_hs_tuple_ty rn_ty mode HsBoxedOrConstraintTuple hs_tys exp_kind + -- (NB: not zonking before looking at exp_k, to avoid left-right bias) + | Just tup_sort <- tupKindSort_maybe exp_kind + = traceTc "tcHsType tuple" (ppr hs_tys) >> + tc_tuple rn_ty mode tup_sort hs_tys exp_kind + | otherwise + = do { traceTc "tcHsType tuple 2" (ppr hs_tys) + ; (tys, kinds) <- mapAndUnzipM (tc_infer_lhs_type mode) hs_tys + ; kinds <- liftZonkM $ mapM zonkTcType kinds + -- Infer each arg type separately, because errors can be + -- confusing if we give them a shared kind. Eg #7410 + -- (Either Int, Int), we do not want to get an error saying + -- "the second argument of a tuple should have kind *->*" + + ; let (arg_kind, tup_sort) + = case [ (k,s) | k <- kinds + , Just s <- [tupKindSort_maybe k] ] of + ((k,s) : _) -> (k,s) + [] -> (liftedTypeKind, BoxedTuple) + -- In the [] case, it's not clear what the kind is, so guess * ---------- Potentially kind-polymorphic types: call the "up" checker --- See Note [Future-proofing the type checker] -tc_hs_type mode ty@(HsTyVar {}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(HsAppTy {}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(HsAppKindTy{}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(HsOpTy {}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(HsKindSig {}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(XHsType {}) ek = tc_infer_hs_type_ek mode ty ek + ; tys' <- sequence [ setSrcSpanA loc $ + checkExpectedKind hs_ty ty kind arg_kind + | ((L loc hs_ty),ty,kind) <- zip3 hs_tys tys kinds ] + + ; finish_tuple rn_ty tup_sort tys' (map (const arg_kind) tys') exp_kind } +tc_hs_tuple_ty rn_ty mode HsUnboxedTuple tys exp_kind = + tc_tuple rn_ty mode UnboxedTuple tys exp_kind {- +Note [Kind-checking explicit lists] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In a type, suppose we have an application (F [t1,t2]), +where [t1,t2] is an explicit list, and + F :: [ki] -> blah + +Then we want to return the type + F ((:) @ki t2 ((:) @ki t2 ([] @ki))) +where the argument list is instantiated to F's argument kind `ki`. + +But what about (G []), where + G :: (forall k. [k]) -> blah + +Here we want to return (G []), with no instantiation at all. But since we have +no lambda in types, we must be careful not to instantiate that `[]`, because we +can't re-generalise it. Hence, when kind-checking an explicit list, we need a +special case for `[]`. + Note [Variable Specificity and Forall Visibility] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A HsForAllTy contains an HsForAllTelescope to denote the visibility of the forall @@ -1366,28 +1342,28 @@ Note [VarBndrs, ForAllTyBinders, TyConBinders, and visibility] in "GHC.Core.TyCo ------------------------------------------ tc_mult :: TcTyMode -> HsArrow GhcRn -> TcM Mult -tc_mult mode ty = tc_lhs_type mode (arrowToHsType ty) multiplicityTy +tc_mult mode ty = tc_check_lhs_type mode (arrowToHsType ty) multiplicityTy ------------------------------------------ -tc_fun_type :: TcTyMode -> HsArrow GhcRn -> LHsType GhcRn -> LHsType GhcRn -> TcKind +tc_fun_type :: TcTyMode -> HsArrow GhcRn -> LHsType GhcRn -> LHsType GhcRn -> ExpKind -> TcM TcType tc_fun_type mode mult ty1 ty2 exp_kind = case mode_tyki mode of TypeLevel -> do { traceTc "tc_fun_type" (ppr ty1 $$ ppr ty2) ; arg_k <- newOpenTypeKind ; res_k <- newOpenTypeKind - ; ty1' <- tc_lhs_type mode ty1 arg_k - ; ty2' <- tc_lhs_type mode ty2 res_k + ; ty1' <- tc_check_lhs_type mode ty1 arg_k + ; ty2' <- tc_check_lhs_type mode ty2 res_k ; mult' <- tc_mult mode mult - ; checkExpectedKind (HsFunTy noExtField mult ty1 ty2) - (tcMkVisFunTy mult' ty1' ty2') - liftedTypeKind exp_kind } + ; checkExpKind (HsFunTy noExtField mult ty1 ty2) + (tcMkVisFunTy mult' ty1' ty2') + liftedTypeKind exp_kind } KindLevel -> -- no representation polymorphism in kinds. yet. - do { ty1' <- tc_lhs_type mode ty1 liftedTypeKind - ; ty2' <- tc_lhs_type mode ty2 liftedTypeKind + do { ty1' <- tc_check_lhs_type mode ty1 liftedTypeKind + ; ty2' <- tc_check_lhs_type mode ty2 liftedTypeKind ; mult' <- tc_mult mode mult - ; checkExpectedKind (HsFunTy noExtField mult ty1 ty2) - (tcMkVisFunTy mult' ty1' ty2') - liftedTypeKind exp_kind } + ; checkExpKind (HsFunTy noExtField mult ty1 ty2) + (tcMkVisFunTy mult' ty1' ty2') + liftedTypeKind exp_kind } {- Note [Skolem escape and forall-types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1442,7 +1418,7 @@ tc_tuple rn_ty mode tup_sort tys exp_kind BoxedTuple -> return (replicate arity liftedTypeKind) UnboxedTuple -> replicateM arity newOpenTypeKind ConstraintTuple -> return (replicate arity constraintKind) - ; tau_tys <- zipWithM (tc_lhs_type mode) tys arg_kinds + ; tau_tys <- zipWithM (tc_check_lhs_type mode) tys arg_kinds ; finish_tuple rn_ty tup_sort tau_tys arg_kinds exp_kind } where arity = length tys @@ -1530,9 +1506,9 @@ since the two constraints should be semantically equivalent. * * ********************************************************************* -} -splitHsAppTys :: HsType GhcRn -> Maybe (LHsType GhcRn, [LHsTypeArg GhcRn]) -splitHsAppTys hs_ty - | is_app hs_ty = Just (go (noLocA hs_ty) []) +splitHsAppTys_maybe :: HsType GhcRn -> Maybe (LHsType GhcRn, [LHsTypeArg GhcRn]) +splitHsAppTys_maybe hs_ty + | is_app hs_ty = Just (splitHsAppTys hs_ty) | otherwise = Nothing where is_app :: HsType GhcRn -> Bool @@ -1547,6 +1523,10 @@ splitHsAppTys hs_ty is_app (HsParTy _ (L _ ty)) = is_app ty is_app _ = False +splitHsAppTys :: HsType GhcRn -> (LHsType GhcRn, [LHsTypeArg GhcRn]) + +splitHsAppTys hs_ty = go (noLocA hs_ty) [] + where go :: LHsType GhcRn -> [HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)] -> (LHsType GhcRn, @@ -1570,6 +1550,14 @@ tcInferTyAppHead _ (L _ (HsTyVar _ _ (L _ tv))) tcInferTyAppHead mode ty = tc_infer_lhs_type mode ty +tc_app_ty :: TcTyMode -> HsType GhcRn -> ExpKind -> TcM TcType +tc_app_ty mode rn_ty exp_kind + = do { (fun_ty, _ki) <- tcInferTyAppHead mode hs_fun_ty + ; (ty, infered_kind) <- tcInferTyApps mode hs_fun_ty fun_ty hs_args + ; checkExpKind rn_ty ty infered_kind exp_kind } + where + (hs_fun_ty, hs_args) = splitHsAppTys rn_ty + --------------------------- -- | Apply a type of a given kind to a list of arguments. This instantiates -- invisible parameters as necessary. Always consumes all the arguments, @@ -1656,7 +1644,7 @@ tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args ; arg_mode <- mkHoleMode KindLevel HM_VTA -- HM_VKA: see Note [Wildcards in visible kind application] ; ki_arg <- addErrCtxt (funAppCtxt orig_hs_ty hs_ki_arg n) $ - tc_lhs_type arg_mode hs_ki_arg exp_kind + tc_check_lhs_type arg_mode hs_ki_arg exp_kind ; traceTc "tcInferTyApps (vis kind app)" (ppr exp_kind) ; (subst', fun') <- mkAppTyM subst fun ki_binder ki_arg @@ -1687,7 +1675,7 @@ tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args , ppr subst ]) ; let exp_kind = substTy subst $ piTyBinderType ki_binder ; arg' <- addErrCtxt (funAppCtxt orig_hs_ty arg n) $ - tc_lhs_type mode arg exp_kind + tc_check_lhs_type mode arg exp_kind ; traceTc "tcInferTyApps (vis normal app) 2" (ppr exp_kind) ; (subst', fun') <- mkAppTyM subst fun ki_binder arg' ; go (n+1) fun' subst' inner_ki args } @@ -1975,6 +1963,19 @@ checkExpectedKind hs_ty ty act_kind exp_kind n_act_invis_bndrs = invisibleTyBndrCount act_kind n_to_inst = n_act_invis_bndrs - n_exp_invis_bndrs + +-- tyr <- checkExpKind hs_ty ty (act_ki :: Kind) (exp_ki :: ExpKind) +-- requires that `ty` has kind `act_ki` +-- It checks that the actual kind `act_ki` matches the expected kind `exp_ki` +-- and returns `tyr`, a possibly-casted form of `ty`, that has precisely kind `exp_ki` +-- `hs_ty` is purely for error messages +checkExpKind :: HsType GhcRn -> TcType -> TcKind -> ExpKind -> TcM TcType +checkExpKind rn_ty ty ki (Check ki') = + checkExpectedKind rn_ty ty ki ki' +checkExpKind _rn_ty ty ki (Infer cell) = do + co <- fillInferResult ki cell + pure (ty `mkCastTy` co) + --------------------------- tcHsContext :: Maybe (LHsContext GhcRn) -> TcM [PredType] @@ -1988,7 +1989,7 @@ tc_hs_context :: TcTyMode -> LHsContext GhcRn -> TcM [PredType] tc_hs_context mode ctxt = mapM (tc_lhs_pred mode) (unLoc ctxt) tc_lhs_pred :: TcTyMode -> LHsType GhcRn -> TcM PredType -tc_lhs_pred mode pred = tc_lhs_type mode pred constraintKind +tc_lhs_pred mode pred = tc_check_lhs_type mode pred constraintKind --------------------------- tcTyVar :: Name -> TcM (TcType, TcKind) @@ -4109,7 +4110,7 @@ tcHsPartialSigType ctxt sig_ty ; tau <- -- Don't do (addTypeCtxt hs_tau) here else we get -- In the type -- In the type signature: foo :: - tc_lhs_type mode hs_tau ek + tc_check_lhs_type mode hs_tau ek ; return (wcs, wcx, theta, tau) } @@ -4419,8 +4420,8 @@ tc_type_in_pat ctxt hole_mode hs_ty wcs ns ctxt_kind -- and c.f #16033 bindNamedWildCardBinders wcs $ \ wcs -> tcExtendNameTyVarEnv tkv_prs $ - do { ek <- newExpectedKind ctxt_kind - ; ty <- tc_lhs_type mode hs_ty ek + do { ek <- newExpectedKind ctxt_kind + ; ty <- tc_check_lhs_type mode hs_ty ek ; return (wcs, ty) } ; mapM_ emitNamedTypeHole wcs @@ -4596,7 +4597,7 @@ tc_lhs_kind_sig mode ctxt hs_kind -- Result is zonked = do { kind <- addErrCtxt (text "In the kind" <+> quotes (ppr hs_kind)) $ solveEqualities "tcLHsKindSig" $ - tc_lhs_type mode hs_kind liftedTypeKind + tc_check_lhs_type mode hs_kind liftedTypeKind ; traceTc "tcLHsKindSig" (ppr hs_kind $$ ppr kind) -- No generalization: ; kindGeneralizeNone kind ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -1772,7 +1772,7 @@ kcTyClDecl (DataDecl { tcdLName = (L _ _name), tcdDataDefn = HsDataDefn { dd_ kcTyClDecl (SynDecl { tcdLName = L _ _name, tcdRhs = rhs }) tycon = tcExtendNameTyVarEnv (tcTyConScopedTyVars tycon) $ let res_kind = tyConResKind tycon - in discardResult $ tcCheckLHsType rhs (TheKind res_kind) + in discardResult $ tcCheckLHsTypeInContext rhs (TheKind res_kind) -- NB: check against the result kind that we allocated -- in inferInitialKinds. @@ -1801,7 +1801,7 @@ kcTyClDecl (FamDecl _ (FamilyDecl { fdInfo = fd_info })) fam_tc kcConArgTys :: NewOrData -> TcKind -> [HsScaled GhcRn (LHsType GhcRn)] -> TcM () kcConArgTys new_or_data res_kind arg_tys = do { let exp_kind = getArgExpKind new_or_data res_kind - ; forM_ arg_tys (\(HsScaled mult ty) -> do _ <- tcCheckLHsType (getBangType ty) exp_kind + ; forM_ arg_tys (\(HsScaled mult ty) -> do _ <- tcCheckLHsTypeInContext (getBangType ty) exp_kind tcMult mult) -- See Note [Implementation of UnliftedNewtypes], STEP 2 } @@ -1868,7 +1868,7 @@ kcConDecl new_or_data do { _ <- tcHsContext cxt ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty) ; con_res_kind <- newOpenTypeKind - ; _ <- tcCheckLHsType res_ty (TheKind con_res_kind) + ; _ <- tcCheckLHsTypeInContext res_ty (TheKind con_res_kind) ; kcConGADTArgs new_or_data con_res_kind args ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr con_res_kind) ; return () } @@ -1895,7 +1895,7 @@ Otherwise we'd infer the bogus kind The type signature for MkT influences the kind of T simply by kind-checking the result type (T g b), which will force 'f' and 'g' to have the same kinds. This is the call to - tcCheckLHsType res_ty (TheKind con_res_kind) + tcCheckLHsTypeInContext res_ty (TheKind con_res_kind) Because this is the result type of an arrow, we know the kind must be of form (TYPE rr), and we get better error messages if we enforce that here (e.g. test gadt10). @@ -3054,7 +3054,7 @@ tcTySynRhs roles_info tc_name hs_ty do { env <- getLclEnv ; traceTc "tc-syn" (ppr tc_name $$ ppr (getLclEnvRdrEnv env)) ; rhs_ty <- pushLevelAndSolveEqualities skol_info tc_bndrs $ - tcCheckLHsType hs_ty (TheKind res_kind) + tcCheckLHsTypeInContext hs_ty (TheKind res_kind) -- See Note [Error on unconstrained meta-variables] in GHC.Tc.Utils.TcMType -- Example: (typecheck/should_fail/T17567) @@ -3197,7 +3197,7 @@ kcTyFamInstEqn tc_fam_tc ; discardResult $ bindOuterFamEqnTKBndrs_Q_Tv outer_bndrs $ do { (_fam_app, res_kind) <- tcFamTyPats tc_fam_tc hs_pats - ; tcCheckLHsType hs_rhs_ty (TheKind res_kind) } + ; tcCheckLHsTypeInContext hs_rhs_ty (TheKind res_kind) } -- Why "_Tv" here? Consider (#14066) -- type family Bar x y where -- Bar (x :: a) (y :: b) = Int @@ -3349,7 +3349,7 @@ tcTyFamInstEqnGuts fam_tc mb_clsinfo outer_hs_bndrs hs_pats hs_rhs_ty -- Ensure that the instance is consistent with its -- parent class (#16008) ; addConsistencyConstraints mb_clsinfo lhs_ty - ; rhs_ty <- tcCheckLHsType hs_rhs_ty (TheKind rhs_kind) + ; rhs_ty <- tcCheckLHsTypeInContext hs_rhs_ty (TheKind rhs_kind) ; return (lhs_ty, rhs_ty) } ; outer_bndrs <- scopedSortOuter outer_bndrs @@ -3926,7 +3926,7 @@ tcConArg :: ContextKind -- expected kind for args; always OpenKind for datatype -> HsScaled GhcRn (LHsType GhcRn) -> TcM (Scaled TcType, HsSrcBang) tcConArg exp_kind (HsScaled w bty) = do { traceTc "tcConArg 1" (ppr bty) - ; arg_ty <- tcCheckLHsType (getBangType bty) exp_kind + ; arg_ty <- tcCheckLHsTypeInContext (getBangType bty) exp_kind ; w' <- tcDataConMult w ; traceTc "tcConArg 2" (ppr bty) ; return (Scaled w' arg_ty, getBangStrictness bty) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Tc.Utils.TcType ( TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcInvisTVBinder, TcReqTVBinder, TcTyCon, MonoTcTyCon, PolyTcTyCon, TcTyConBinder, KnotTied, - ExpType(..), InferResult(..), + ExpType(..), ExpKind, InferResult(..), ExpTypeFRR, ExpSigmaType, ExpSigmaTypeFRR, ExpRhoType, mkCheckExpType, @@ -433,6 +433,9 @@ type ExpSigmaTypeFRR = ExpTypeFRR type ExpRhoType = ExpType +-- | Like 'ExpType', but on kind level +type ExpKind = ExpType + instance Outputable ExpType where ppr (Check ty) = text "Check" <> braces (ppr ty) ppr (Infer ir) = ppr ir ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -43,6 +43,8 @@ module GHC.Tc.Utils.Unify ( PuResult(..), failCheckWith, okCheckRefl, mapCheck, TyEqFlags(..), TyEqFamApp(..), AreUnifying(..), LevelCheck(..), FamAppBreaker, famAppArgFlags, simpleUnifyCheck, checkPromoteFreeVars, + + fillInferResult, ) where import GHC.Prelude ===================================== compiler/Language/Haskell/Syntax/Type.hs ===================================== @@ -1006,7 +1006,7 @@ would mean that when we pretty-print it back, we don't know whether the user wrote '*' or 'Type', and lose the parse/ppr roundtrip property. As a workaround, we parse '*' as HsStarTy (if it stands for 'Data.Kind.Type') -and then desugar it to 'Data.Kind.Type' in the typechecker (see tc_hs_type). +and then desugar it to 'Data.Kind.Type' in the typechecker (see tcHsType). When '*' is a regular type operator (StarIsType is disabled), HsStarTy is not involved. ===================================== rts/TSANUtils.c ===================================== @@ -2,7 +2,7 @@ #if defined(TSAN_ENABLED) -uint64_t ghc_tsan_atomic64_compare_exchange(uint64_t *ptr, uint64_t expected, uint64_t new_value, int success_memorder, int failure_memorder) +__tsan_atomic64 ghc_tsan_atomic64_compare_exchange(volatile __tsan_atomic64 *ptr, __tsan_atomic64 expected, __tsan_atomic64 new_value, int success_memorder, int failure_memorder) { __tsan_atomic64_compare_exchange_strong( ptr, &expected, new_value, @@ -10,7 +10,7 @@ uint64_t ghc_tsan_atomic64_compare_exchange(uint64_t *ptr, uint64_t expected, ui return expected; } -uint32_t ghc_tsan_atomic32_compare_exchange(uint32_t *ptr, uint32_t expected, uint32_t new_value, int success_memorder, int failure_memorder) +__tsan_atomic32 ghc_tsan_atomic32_compare_exchange(volatile __tsan_atomic32 *ptr, __tsan_atomic32 expected, __tsan_atomic32 new_value, int success_memorder, int failure_memorder) { __tsan_atomic32_compare_exchange_strong( ptr, &expected, new_value, @@ -18,7 +18,7 @@ uint32_t ghc_tsan_atomic32_compare_exchange(uint32_t *ptr, uint32_t expected, ui return expected; } -uint16_t ghc_tsan_atomic16_compare_exchange(uint16_t *ptr, uint16_t expected, uint16_t new_value, int success_memorder, int failure_memorder) +__tsan_atomic16 ghc_tsan_atomic16_compare_exchange(volatile __tsan_atomic16 *ptr, __tsan_atomic16 expected, __tsan_atomic16 new_value, int success_memorder, int failure_memorder) { __tsan_atomic16_compare_exchange_strong( ptr, &expected, new_value, @@ -26,7 +26,7 @@ uint16_t ghc_tsan_atomic16_compare_exchange(uint16_t *ptr, uint16_t expected, ui return expected; } -uint8_t ghc_tsan_atomic8_compare_exchange(uint8_t *ptr, uint8_t expected, uint8_t new_value, int success_memorder, int failure_memorder) +__tsan_atomic8 ghc_tsan_atomic8_compare_exchange(volatile __tsan_atomic8 *ptr, __tsan_atomic8 expected, __tsan_atomic8 new_value, int success_memorder, int failure_memorder) { __tsan_atomic8_compare_exchange_strong( ptr, &expected, new_value, ===================================== rts/include/Cmm.h ===================================== @@ -698,11 +698,11 @@ #define ACQUIRE_FENCE prim %fence_acquire(); #define SEQ_CST_FENCE prim %fence_seq_cst(); -#if TSAN_ENABLED +#if defined(TSAN_ENABLED) // This is may be efficient than a fence but TSAN can reason about it. -#if WORD_SIZE_IN_BITS == 64 +#if SIZEOF_W == 8 #define ACQUIRE_FENCE_ON(x) if (1) { W_ tmp; (tmp) = prim %load_acquire64(x); } -#elif WORD_SIZE_IN_BITS == 32 +#elif SIZEOF_W == 4 #define ACQUIRE_FENCE_ON(x) if (1) { W_ tmp; (tmp) = prim %load_acquire32(x); } #endif #else ===================================== rts/include/rts/TSANUtils.h ===================================== @@ -98,10 +98,18 @@ void AnnotateBenignRaceSized(const char *file, #define TSAN_ANNOTATE_BENIGN_RACE(addr,desc) \ TSAN_ANNOTATE_BENIGN_RACE_SIZED((void*)(addr), sizeof(*addr), desc) +#if defined(TSAN_ENABLED) && defined(__clang__) +#include +#else +typedef char __tsan_atomic8; +typedef short __tsan_atomic16; +typedef int __tsan_atomic32; +typedef long __tsan_atomic64; +#endif -uint64_t ghc_tsan_atomic64_compare_exchange(uint64_t *ptr, uint64_t expected, uint64_t new_value, int success_memorder, int failure_memorder); -uint32_t ghc_tsan_atomic32_compare_exchange(uint32_t *ptr, uint32_t expected, uint32_t new_value, int success_memorder, int failure_memorder); -uint16_t ghc_tsan_atomic16_compare_exchange(uint16_t *ptr, uint16_t expected, uint16_t new_value, int success_memorder, int failure_memorder); -uint8_t ghc_tsan_atomic8_compare_exchange(uint8_t *ptr, uint8_t expected, uint8_t new_value, int success_memorder, int failure_memorder); +__tsan_atomic64 ghc_tsan_atomic64_compare_exchange(volatile __tsan_atomic64 *ptr, __tsan_atomic64 expected, __tsan_atomic64 new_value, int success_memorder, int failure_memorder); +__tsan_atomic32 ghc_tsan_atomic32_compare_exchange(volatile __tsan_atomic32 *ptr, __tsan_atomic32 expected, __tsan_atomic32 new_value, int success_memorder, int failure_memorder); +__tsan_atomic16 ghc_tsan_atomic16_compare_exchange(volatile __tsan_atomic16 *ptr, __tsan_atomic16 expected, __tsan_atomic16 new_value, int success_memorder, int failure_memorder); +__tsan_atomic8 ghc_tsan_atomic8_compare_exchange(volatile __tsan_atomic8 *ptr, __tsan_atomic8 expected, __tsan_atomic8 new_value, int success_memorder, int failure_memorder); #endif ===================================== rts/include/stg/SMP.h ===================================== @@ -549,9 +549,14 @@ busy_wait_nop(void) #define SEQ_CST_FENCE() __atomic_thread_fence(__ATOMIC_SEQ_CST) #if defined(TSAN_ENABLED) +#if !defined(__clang__) +#undef ACQUIRE_FENCE +#undef RELEASE_FENCE +#undef SEQ_CST_FENCE #define ACQUIRE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_ACQUIRE);) #define RELEASE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_RELEASE);) #define SEQ_CST_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_SEQ_CST);) +#endif #define ACQUIRE_FENCE_ON(x) (void)ACQUIRE_LOAD(x) #else #define ACQUIRE_FENCE_ON(x) __atomic_thread_fence(__ATOMIC_ACQUIRE) ===================================== rts/rts.cabal ===================================== @@ -184,7 +184,6 @@ library if flag(thread-sanitizer) cc-options: -fsanitize=thread ld-options: -fsanitize=thread - extra-libraries: tsan if os(linux) -- the RTS depends upon libc. while this dependency is generally ===================================== testsuite/tests/partial-sigs/should_run/GHCiWildcardKind.stdout ===================================== @@ -1,2 +1,2 @@ -_ :: k +_ :: p Maybe _ :: * ===================================== testsuite/tests/th/T24299.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T24299 where +import Language.Haskell.TH.Syntax (addModFinalizer, runIO) +import GHC.Types (Type) +import System.IO + +type Proxy :: forall a. a -> Type +data Proxy a = MkProxy + +check :: ($(addModFinalizer (runIO (do putStrLn "check"; hFlush stdout)) >> + [t| Proxy |]) :: Type -> Type) Int -- There is kind signature, we are in check mode +check = MkProxy + +infer :: ($(addModFinalizer (runIO (do putStrLn "infer"; hFlush stdout)) >> + [t| Proxy |]) ) Int -- no kind signature, inference mode is enabled +infer = MkProxy ===================================== testsuite/tests/th/T24299.stderr ===================================== @@ -0,0 +1,2 @@ +check +infer ===================================== testsuite/tests/th/all.T ===================================== @@ -606,3 +606,4 @@ test('T14032e', normal, compile_fail, ['-dsuppress-uniques']) test('ListTuplePunsTH', [only_ways(['ghci']), extra_files(['ListTuplePunsTH.hs', 'T15843a.hs'])], ghci_script, ['ListTuplePunsTH.script']) test('T24559', normal, compile, ['']) test('T24571', normal, compile, ['']) +test('T24299', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9884f016e07e78aff67a38786c45a536621a20e...c1c37c47130f1f78137f49a1bfb5e0e3dd322b37 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9884f016e07e78aff67a38786c45a536621a20e...c1c37c47130f1f78137f49a1bfb5e0e3dd322b37 You're receiving 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 Apr 2 13:13:59 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 02 Apr 2024 09:13:59 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] fixup! rts: Make addDLL a wrapper around loadNativeObj Message-ID: <660c04979fa87_26e1f6242bccc137895@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 07b5e766 by Rodrigo Mesquita at 2024-04-02T14:13:45+01:00 fixup! rts: Make addDLL a wrapper around loadNativeObj - - - - - 4 changed files: - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== rts/Linker.c ===================================== @@ -643,7 +643,13 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; @@ -652,7 +658,6 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,19 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = addDLL_PEi386(path, &(HINSTANCE)r); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1884,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,7 +1,10 @@ -#include "CheckUnload.h" -#include "ForeignExports.h" #include "LinkerInternals.h" #include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" #include "RtsUtils.h" #include "Profiling.h" @@ -208,4 +211,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1141,47 +1141,55 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent); + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+1,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07b5e766fd3d08a8056982488918e272025fb69a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07b5e766fd3d08a8056982488918e272025fb69a You're receiving 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 Apr 2 13:19:55 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 02 Apr 2024 09:19:55 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] fixup! rts: Make addDLL a wrapper around loadNativeObj Message-ID: <660c05fb99da8_26e1f625441e013835a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 0116da1c by Rodrigo Mesquita at 2024-04-02T14:19:45+01:00 fixup! rts: Make addDLL a wrapper around loadNativeObj - - - - - 4 changed files: - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== rts/Linker.c ===================================== @@ -643,7 +643,13 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; @@ -652,7 +658,6 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,19 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { - IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%PATH_FMT'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1884,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,7 +1,10 @@ -#include "CheckUnload.h" -#include "ForeignExports.h" #include "LinkerInternals.h" #include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" #include "RtsUtils.h" #include "Profiling.h" @@ -208,4 +211,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1141,47 +1141,55 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent); + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+1,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0116da1c6e5d11441c44ee1d4e75760fd6b0ac85 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0116da1c6e5d11441c44ee1d4e75760fd6b0ac85 You're receiving 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 Apr 2 13:22:45 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 02 Apr 2024 09:22:45 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] fixup! rts: Make addDLL a wrapper around loadNativeObj Message-ID: <660c06a536605_39cba685520196eb@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: d445f1b3 by Rodrigo Mesquita at 2024-04-02T14:21:53+01:00 fixup! rts: Make addDLL a wrapper around loadNativeObj - - - - - 4 changed files: - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== rts/Linker.c ===================================== @@ -643,7 +643,13 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; @@ -652,7 +658,6 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,19 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { - IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1884,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,7 +1,10 @@ -#include "CheckUnload.h" -#include "ForeignExports.h" #include "LinkerInternals.h" #include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" #include "RtsUtils.h" #include "Profiling.h" @@ -208,4 +211,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1141,47 +1141,55 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent); + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+1,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d445f1b32208c16908707bc8a930c4b856d53b26 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d445f1b32208c16908707bc8a930c4b856d53b26 You're receiving 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 Apr 2 13:24:26 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 02 Apr 2024 09:24:26 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 2 commits: fixup! rts: lookupSymbolInNativeObj in Windows Message-ID: <660c070a946fd_39cba61e573020111@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: b072d397 by Rodrigo Mesquita at 2024-04-02T14:24:07+01:00 fixup! rts: lookupSymbolInNativeObj in Windows - - - - - 896de9ca by Rodrigo Mesquita at 2024-04-02T14:24:10+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 9 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -643,7 +643,13 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; @@ -652,7 +658,6 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,19 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { - IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1884,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,7 +1,10 @@ -#include "CheckUnload.h" -#include "ForeignExports.h" #include "LinkerInternals.h" #include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" #include "RtsUtils.h" #include "Profiling.h" @@ -208,4 +211,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1141,47 +1141,55 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent); + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+1,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d445f1b32208c16908707bc8a930c4b856d53b26...896de9ca275c52bff530aafd343ceb246866d2f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d445f1b32208c16908707bc8a930c4b856d53b26...896de9ca275c52bff530aafd343ceb246866d2f5 You're receiving 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 Apr 2 13:45:29 2024 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 02 Apr 2024 09:45:29 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/invis-pats-change-ast] Change how invisible patterns represented in haskell syntax and TH AST (#24557) Message-ID: <660c0bf991b9b_39cba65a5fc8267c6@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/invis-pats-change-ast at Glasgow Haskell Compiler / GHC Commits: 64339f17 by Andrei Borzenkov at 2024-04-02T17:45:09+04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Functor.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 - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Zonk/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64339f17846405e046f8c6d241ef1a2887ffe37d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64339f17846405e046f8c6d241ef1a2887ffe37d You're receiving 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 Apr 2 14:52:58 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 02 Apr 2024 10:52:58 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 3 commits: Simplifier improvements Message-ID: <660c1bcaeb80a_2bcef227862023858@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 8b2a088d by Simon Peyton Jones at 2024-04-02T15:52:49+01:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: T13253-spj T18304 T18698a T9961 T3294 - - - - - e9149c8c by Simon Peyton Jones at 2024-04-02T15:52:49+01:00 Testsuite message changes from simplifier improvements - - - - - 848f360f by Simon Peyton Jones at 2024-04-02T15:52:49+01:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 24 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Stats.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Tickish.hs - testsuite/tests/arityanal/should_compile/Arity01.stderr - testsuite/tests/arityanal/should_compile/Arity02.stderr - testsuite/tests/arityanal/should_compile/Arity09.stderr - testsuite/tests/arityanal/should_compile/Arity13.stderr - testsuite/tests/cpranal/should_compile/T18401.stderr - testsuite/tests/driver/inline-check.stderr - testsuite/tests/lib/integer/Makefile - testsuite/tests/numeric/should_compile/T19641.stderr - testsuite/tests/perf/compiler/T15630.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c556cf6d71e096eb62851503fc04266d1e32895b...848f360fe1bcbdac28e9cc0014665bf8ccbfd259 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c556cf6d71e096eb62851503fc04266d1e32895b...848f360fe1bcbdac28e9cc0014665bf8ccbfd259 You're receiving 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 Apr 2 14:55:24 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 02 Apr 2024 10:55:24 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 2 commits: fixup! rts: lookupSymbolInNativeObj in Windows Message-ID: <660c1c5c33da_2bcef239a8dc2789@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 9d80352f by Rodrigo Mesquita at 2024-04-02T15:54:58+01:00 fixup! rts: lookupSymbolInNativeObj in Windows - - - - - 96fb179d by Rodrigo Mesquita at 2024-04-02T15:54:58+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 9 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -643,7 +643,13 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; @@ -652,7 +658,6 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,19 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { - IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1884,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,7 +1,10 @@ -#include "CheckUnload.h" -#include "ForeignExports.h" #include "LinkerInternals.h" #include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" #include "RtsUtils.h" #include "Profiling.h" @@ -208,4 +211,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1141,47 +1141,58 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent); + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent) +{ +#if !defined(DEBUG) + UNUSED(dll_name); +#endif + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ + + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+1,dll_name);*/ + return sym; + } - sym = GetProcAddress(o_dll->instance, lbl); + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/896de9ca275c52bff530aafd343ceb246866d2f5...96fb179d5fd008bdf4a1ef87a2e49a6e35452ccf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/896de9ca275c52bff530aafd343ceb246866d2f5...96fb179d5fd008bdf4a1ef87a2e49a6e35452ccf You're receiving 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 Apr 2 14:56:36 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 02 Apr 2024 10:56:36 -0400 Subject: [Git][ghc/ghc][wip/mco-in-exprIsConApp] Try using MCoercion in exprIsConApp_maybe Message-ID: <660c1ca4acb52_2bcef24282182834e@gitlab.mail> Simon Peyton Jones pushed to branch wip/mco-in-exprIsConApp at Glasgow Haskell Compiler / GHC Commits: 6d6e9d57 by Simon Peyton Jones at 2024-04-02T15:56:27+01:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 2 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/SimpleOpt.hs Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3023,7 +3023,7 @@ pushCoercionIntoLambda in_scope x e co | otherwise = Nothing -pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion +pushCoDataCon :: DataCon -> [CoreExpr] -> MCoercion -> Maybe (DataCon , [Type] -- Universal type args , [CoreExpr]) -- All other args incl existentials @@ -3033,10 +3033,20 @@ pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion -- where co :: (T t1 .. tn) ~ to_ty -- The left-hand one must be a T, because exprIsConApp returned True -- but the right-hand one might not be. (Though it usually will.) -pushCoDataCon dc dc_args co - | isReflCo co || from_ty `eqType` to_ty -- try cheap test first - , let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args - = Just (dc, map exprToType univ_ty_args, rest_args) +pushCoDataCon dc dc_args MRefl = Just $! (push_dc_refl dc dc_args) +pushCoDataCon dc dc_args (MCo co) = push_dc_gen dc dc_args co (coercionKind co) + +push_dc_refl :: DataCon -> [CoreExpr] -> (DataCon, [Type], [CoreExpr]) +push_dc_refl dc dc_args + = (dc, map exprToType univ_ty_args, rest_args) + where + !(univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args + +push_dc_gen :: DataCon -> [CoreExpr] -> Coercion -> Pair Type + -> Maybe (DataCon, [Type], [CoreExpr]) +push_dc_gen dc dc_args co (Pair from_ty to_ty) + | from_ty `eqType` to_ty -- try cheap test first + = Just $! (push_dc_refl dc dc_args) | Just (to_tc, to_tc_arg_tys) <- splitTyConApp_maybe to_ty , to_tc == dataConTyCon dc @@ -3082,8 +3092,6 @@ pushCoDataCon dc dc_args co | otherwise = Nothing - where - Pair from_ty to_ty = coercionKind co collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr) -- Collect lambda binders, pushing coercions inside if possible ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -1211,7 +1211,7 @@ data-con wrappers, and that cure would be worse than the disease. This Note exists solely to document the problem. -} -data ConCont = CC [CoreExpr] Coercion +data ConCont = CC [CoreExpr] MCoercion -- Substitution already applied -- | Returns @Just ([b1..bp], dc, [t1..tk], [x1..xn])@ if the argument @@ -1233,7 +1233,7 @@ exprIsConApp_maybe :: HasDebugCallStack => InScopeEnv -> CoreExpr -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr]) exprIsConApp_maybe ise@(ISE in_scope id_unf) expr - = go (Left in_scope) [] expr (CC [] (mkRepReflCo (exprType expr))) + = go (Left in_scope) [] expr (CC [] MRefl) where go :: Either InScopeSet Subst -- Left in-scope means "empty substitution" @@ -1246,14 +1246,12 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr go subst floats (Tick t expr) cont | not (tickishIsCode t) = go subst floats expr cont - go subst floats (Cast expr co1) (CC args co2) + go subst floats (Cast expr co1) (CC args m_co2) | Just (args', m_co1') <- pushCoArgs (subst_co subst co1) args -- See Note [Push coercions in exprIsConApp_maybe] - = case m_co1' of - MCo co1' -> go subst floats expr (CC args' (co1' `mkTransCo` co2)) - MRefl -> go subst floats expr (CC args' co2) + = go subst floats expr (CC args' (m_co1' `mkTransMCo` m_co2)) - go subst floats (App fun arg) (CC args co) + go subst floats (App fun arg) (CC args mco) | let arg_type = exprType arg , not (isTypeArg arg) && needsCaseBinding arg_type arg -- An unlifted argument that’s not ok for speculation must not simply be @@ -1276,17 +1274,17 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr bndr = uniqAway (subst_in_scope subst) (mkWildValBinder ManyTy arg_type) float = FloatCase arg' bndr DEFAULT [] subst' = subst_extend_in_scope subst bndr - in go subst' (float:floats) fun (CC (Var bndr : args) co) + in go subst' (float:floats) fun (CC (Var bndr : args) mco) | otherwise - = go subst floats fun (CC (subst_expr subst arg : args) co) + = go subst floats fun (CC (subst_expr subst arg : args) mco) - go subst floats (Lam bndr body) (CC (arg:args) co) + go subst floats (Lam bndr body) (CC (arg:args) mco) | do_beta_by_substitution bndr arg - = go (extend subst bndr arg) floats body (CC args co) + = go (extend subst bndr arg) floats body (CC args mco) | otherwise = let (subst', bndr') = subst_bndr subst bndr float = FloatLet (NonRec bndr' arg) - in go subst' (float:floats) body (CC args co) + in go subst' (float:floats) body (CC args mco) go subst floats (Let (NonRec bndr rhs) expr) cont | not (isJoinId bndr) @@ -1311,12 +1309,12 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr (lookupIdSubst sub v) cont - go (Left in_scope) floats (Var fun) cont@(CC args co) + go (Left in_scope) floats (Var fun) cont@(CC args mco) | Just con <- isDataConWorkId_maybe fun , count isValArg args == idArity fun = succeedWith in_scope floats $ - pushCoDataCon con args co + pushCoDataCon con args mco -- Look through data constructor wrappers: they inline late (See Note -- [Activation for data constructor wrappers]) but we want to do @@ -1336,7 +1334,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- simplOptExpr initialises the in-scope set with exprFreeVars, -- but that doesn't account for DFun unfoldings = succeedWith in_scope floats $ - pushCoDataCon con (map (substExpr subst) dfun_args) co + pushCoDataCon con (map (substExpr subst) dfun_args) mco -- Look through unfoldings, but only arity-zero one; -- if arity > 0 we are effectively inlining a function call, @@ -1354,7 +1352,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr , [arg] <- args , Just (LitString str) <- exprIsLiteral_maybe ise arg = succeedWith in_scope floats $ - dealWithStringLiteral fun str co + dealWithStringLiteral fun str mco where unfolding = id_unf fun extend_in_scope unf_fvs @@ -1404,15 +1402,15 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- See Note [exprIsConApp_maybe on literal strings] -dealWithStringLiteral :: Var -> BS.ByteString -> Coercion +dealWithStringLiteral :: Var -> BS.ByteString -> MCoercion -> Maybe (DataCon, [Type], [CoreExpr]) -- This is not possible with user-supplied empty literals, GHC.Core.Make.mkStringExprFS -- turns those into [] automatically, but just in case something else in GHC -- generates a string literal directly. -dealWithStringLiteral fun str co = +dealWithStringLiteral fun str mco = case utf8UnconsByteString str of - Nothing -> pushCoDataCon nilDataCon [Type charTy] co + Nothing -> pushCoDataCon nilDataCon [Type charTy] mco Just (char, charTail) -> let char_expr = mkConApp charDataCon [mkCharLit char] -- In singleton strings, just add [] instead of unpackCstring# ""#. @@ -1421,7 +1419,7 @@ dealWithStringLiteral fun str co = else App (Var fun) (Lit (LitString charTail)) - in pushCoDataCon consDataCon [Type charTy, char_expr, rest] co + in pushCoDataCon consDataCon [Type charTy, char_expr, rest] mco {- Note [Unfolding DFuns] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d6e9d570898331805b63620b8241ff8970fcf0a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d6e9d570898331805b63620b8241ff8970fcf0a You're receiving 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 Apr 2 15:19:49 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 02 Apr 2024 11:19:49 -0400 Subject: [Git][ghc/ghc][wip/T24604] Deal with duplicate tyvars in type declarations Message-ID: <660c2215e01fd_2bcef28ca1f4403c2@gitlab.mail> Simon Peyton Jones pushed to branch wip/T24604 at Glasgow Haskell Compiler / GHC Commits: f004fd56 by Simon Peyton Jones at 2024-04-02T16:19:31+01:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - 9 changed files: - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/saks/should_compile/all.T - + testsuite/tests/saks/should_compile/saks018.stderr - + testsuite/tests/saks/should_compile/saks021.stderr - testsuite/tests/typecheck/should_compile/T24470b.hs - testsuite/tests/vdq-rta/should_fail/T24604.hs - + testsuite/tests/vdq-rta/should_fail/T24604a.hs - + testsuite/tests/vdq-rta/should_fail/T24604a.stderr - testsuite/tests/vdq-rta/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2573,7 +2573,7 @@ kcCheckDeclHeader_sig sig_kind name flav , text "implict_nms:" <+> ppr implicit_nms , text "hs_tv_bndrs:" <+> ppr hs_tv_bndrs ] - ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, (extra_tcbs, tycon_res_kind)))) + ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, skol_scoped_tvs, (extra_tcbs, tycon_res_kind)))) <- pushLevelAndSolveEqualitiesX "kcCheckDeclHeader_sig" $ -- #16687 bindImplicitTKBndrs_Q_Tv implicit_nms $ -- Q means don't clone matchUpSigWithDecl name sig_tcbs sig_res_kind hs_tv_bndrs $ \ excess_sig_tcbs sig_res_kind -> @@ -2622,11 +2622,10 @@ kcCheckDeclHeader_sig sig_kind name flav -- type UF :: forall zk -> zk -> Constraint -- class UF kk (xb :: k) -- Here `k` and `kk` both denote the same variable; but only `k` is implicit - -- Hence we need to add the visible binders into dup_chk_prs + -- Hence we need to add skol_scoped_tvs ; implicit_tvs <- liftZonkM $ zonkTcTyVarsToTcTyVars implicit_tvs ; let implicit_prs = implicit_nms `zip` implicit_tvs - dup_chk_prs = implicit_prs ++ - [ (tyVarName tv, tv) | Bndr tv vis <- skol_tcbs, isVisibleTcbVis vis ] + dup_chk_prs = implicit_prs ++ mkTyVarNamePairs skol_scoped_tvs ; unless (null implicit_nms) $ -- No need if no implicit tyvars checkForDuplicateScopedTyVars dup_chk_prs ; checkForDisconnectedScopedTyVars name flav all_tcbs implicit_prs @@ -2697,6 +2696,7 @@ matchUpSigWithDecl -> ([TcTyConBinder] -> TcKind -> TcM a) -- All user-written binders are in scope -- Argument is excess TyConBinders and tail kind -> TcM ( [TcTyConBinder] -- Skolemised binders, with TcTyVars + , [TcTyVar] -- Skolem tyvars brought into lexical scope by this matching-up , a ) -- See Note [Matching a kind signature with a declaration] -- Invariant: Length of returned TyConBinders + length of excess TyConBinders @@ -2707,7 +2707,7 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside go subst tcbs [] = do { let (subst', tcbs') = substTyConBindersX subst tcbs ; res <- thing_inside tcbs' (substTy subst' sig_res_kind) - ; return ([], res) } + ; return ([], [], res) } go _ [] hs_bndrs = failWithTc (TcRnTooManyBinders sig_res_kind hs_bndrs) @@ -2724,18 +2724,21 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside subst' = extendTCvSubstWithClone subst tv tv' ; tc_hs_bndr (unLoc hs_bndr) (tyVarKind tv') ; traceTc "musd1" (ppr tcb $$ ppr hs_bndr $$ ppr tv') - ; (tcbs', res) <- tcExtendTyVarEnv [tv'] $ - go subst' tcbs' hs_bndrs' - ; return (Bndr tv' vis : tcbs', res) } + ; (tcbs', tvs, res) <- tcExtendTyVarEnv [tv'] $ + go subst' tcbs' hs_bndrs' + ; return (Bndr tv' vis : tcbs', tv':tvs, res) } + -- We do a tcExtendTyVarEnv [tv'], so we return tv' in + -- the list of lexically-scoped skolem type variables | skippable (binderFlag tcb) = -- Invisible TyConBinder, so do not consume one of the hs_bndrs do { let (subst', tcb') = substTyConBinderX subst tcb ; traceTc "musd2" (ppr tcb $$ ppr hs_bndr $$ ppr tcb') - ; (tcbs', res) <- go subst' tcbs' hs_bndrs + ; (tcbs', tvs, res) <- go subst' tcbs' hs_bndrs -- NB: pass on hs_bndrs unchanged; we do not consume a -- HsTyVarBndr for an invisible TyConBinder - ; return (tcb' : tcbs', res) } + ; return (tcb' : tcbs', tvs, res) } + -- Return `tvs`; no new lexically-scoped TyVars brought into scope | otherwise = -- At this point we conclude that: @@ -2755,9 +2758,13 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. + -- In particular: we match up if + -- (a) HsBndr looks like @k, and TyCon binder is forall k. (NamedTCB Specified) + -- (b) HsBndr looks like a, and TyCon binder is forall k -> (NamedTCB Required) + -- or k -> (AnonTCB) zippable :: TyConBndrVis -> HsBndrVis GhcRn -> Bool - zippable vis (HsBndrRequired _) = isVisibleTcbVis vis - zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis + zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis -- (a) + zippable vis (HsBndrRequired _) = isVisibleTcbVis vis -- (b) -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. @@ -3021,15 +3028,7 @@ checkForDisconnectedScopedTyVars name flav all_tcbs scoped_prs checkForDuplicateScopedTyVars :: [(Name,TcTyVar)] -> TcM () -- Check for duplicates --- E.g. data SameKind (a::k) (b::k) --- data T (a::k1) (b::k2) c = MkT (SameKind a b) c --- Here k1 and k2 start as TyVarTvs, and get unified with each other --- If this happens, things get very confused later, so fail fast --- --- In the CUSK case k1 and k2 are skolems so they won't unify; --- but in the inference case (see generaliseTcTyCon), --- and the type-sig case (see kcCheckDeclHeader_sig), they are --- TcTyVars, so we must check. +-- See Note [Aliasing in type and class declarations] checkForDuplicateScopedTyVars scoped_prs = unless (null err_prs) $ do { mapM_ report_dup err_prs; failM } @@ -3049,8 +3048,41 @@ checkForDuplicateScopedTyVars scoped_prs addErrTc $ TcRnDifferentNamesForTyVar n1 n2 -{- Note [Disconnected type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Aliasing in type and class declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data SameKind (a::k) (b::k) + data T1 (a::k1) (b::k2) c = MkT (SameKind a b) c +We do not allow this, because `k1` and `k2` would both stand for the same type +variable -- they are both aliases for `k`. + +Other examples + data T2 (a::k1) = MkT2 (SameKind a Int) -- k1 stands for Type + data T3 @k1 @k2 (a::k1) (b::k2) = MkT (SameKind a b) -- k1 and k2 are aliases + + type UF :: forall zk. zk -> Constraint + class UF @kk (xb :: k) where -- kk and k are aliases + op :: (xs::kk) -> Bool + +See #24604 for an example that crashed GHC. + +There is a design choice here. It would be possible to allow implicit type variables +like `k1` and `k2` in T1's declartion to stand for /abitrary kinds/. This is in fact +the rule we use in /terms/ pattern signatures: + f :: [Int] -> Int + f ((x::a) : xs) = ... +Here `a` stands for `Int`. But in type /signatures/ we make a different choice: + f1 :: forall (a::k1) (b::k2). SameKind a b -> blah + f2 :: forall (a::k). SameKind a Int -> blah + +Here f1's signature is rejected becaues `k1` and `k2` are aliased; and f2's is +rejected because `k` stands for `Int`. + +Our current choice is that type and class declarations behave more like signatures; +we do not allow aliasing. That is what `checkForDuplicateScopedTyVars` checks. + +Note [Disconnected type variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This note applies when kind-checking the header of a type/class decl that has a separate, standalone kind signature. See #24083. ===================================== testsuite/tests/saks/should_compile/all.T ===================================== @@ -13,10 +13,10 @@ test('saks014', normal, compile, ['']) test('saks015', normal, compile, ['']) test('saks016', normal, compile, ['']) test('saks017', normal, compile, ['']) -test('saks018', normal, compile, ['']) +test('saks018', normal, compile_fail, ['']) test('saks019', normal, compile, ['']) test('saks020', normal, compile, ['']) -test('saks021', normal, compile, ['']) +test('saks021', normal, compile_fail, ['']) test('saks023', normal, ghci_script, ['saks023.script']) test('saks024', normal, compile, ['']) test('saks025', extra_files(['saks025.hs']), ghci_script, ['saks025.script']) ===================================== testsuite/tests/saks/should_compile/saks018.stderr ===================================== @@ -0,0 +1,4 @@ + +saks018.hs:9:8: error: [GHC-17370] + • Different names for the same type variable: ‘hk’ and ‘k’ + • In the data type declaration for ‘T’ ===================================== testsuite/tests/saks/should_compile/saks021.stderr ===================================== @@ -0,0 +1,4 @@ + +saks021.hs:9:8: error: [GHC-17370] + • Different names for the same type variable: ‘hk’ and ‘k’ + • In the data type declaration for ‘T’ ===================================== testsuite/tests/typecheck/should_compile/T24470b.hs ===================================== @@ -7,4 +7,4 @@ import Data.Kind import Data.Data type SynOK :: forall k. k -> Type -type SynOK @t = Proxy :: j -> Type +type SynOK @j = Proxy :: j -> Type ===================================== testsuite/tests/vdq-rta/should_fail/T24604.hs ===================================== @@ -1,6 +1,6 @@ module T24604 where -import Data.Kind (Constraint, Type) +import Data.Kind type UF :: forall zk -> zk -> Constraint class UF kk (xb :: k) where ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeAbstractions #-} + +module T24604a where + +import Data.Kind + +type UF :: forall zk. zk -> Constraint +class UF @kk (xb :: k) where + op :: (xs::kk) -> Bool ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.stderr ===================================== @@ -0,0 +1,4 @@ + +T24604a.hs:8:11: error: [GHC-17370] + • Different names for the same type variable: ‘k’ and ‘kk’ + • In the class declaration for ‘UF’ ===================================== testsuite/tests/vdq-rta/should_fail/all.T ===================================== @@ -19,3 +19,4 @@ test('T24176', normal, compile_fail, ['']) test('T23739_fail_ret', normal, compile_fail, ['']) test('T23739_fail_case', normal, compile_fail, ['']) test('T24604', normal, compile_fail, ['']) +test('T24604a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f004fd56dd5483f85527b5801a3fbdc5a5aac0a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f004fd56dd5483f85527b5801a3fbdc5a5aac0a8 You're receiving 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 Apr 2 15:20:25 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 02 Apr 2024 11:20:25 -0400 Subject: [Git][ghc/ghc][wip/T24604] Deal with duplicate tyvars in type declarations Message-ID: <660c223950c09_2bcef297d7b8423df@gitlab.mail> Simon Peyton Jones pushed to branch wip/T24604 at Glasgow Haskell Compiler / GHC Commits: 60ad6eb6 by Simon Peyton Jones at 2024-04-02T16:20:01+01:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - 9 changed files: - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/saks/should_compile/all.T - + testsuite/tests/saks/should_compile/saks018.stderr - + testsuite/tests/saks/should_compile/saks021.stderr - testsuite/tests/typecheck/should_compile/T24470b.hs - testsuite/tests/vdq-rta/should_fail/T24604.hs - + testsuite/tests/vdq-rta/should_fail/T24604a.hs - + testsuite/tests/vdq-rta/should_fail/T24604a.stderr - testsuite/tests/vdq-rta/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2573,7 +2573,7 @@ kcCheckDeclHeader_sig sig_kind name flav , text "implict_nms:" <+> ppr implicit_nms , text "hs_tv_bndrs:" <+> ppr hs_tv_bndrs ] - ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, (extra_tcbs, tycon_res_kind)))) + ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, skol_scoped_tvs, (extra_tcbs, tycon_res_kind)))) <- pushLevelAndSolveEqualitiesX "kcCheckDeclHeader_sig" $ -- #16687 bindImplicitTKBndrs_Q_Tv implicit_nms $ -- Q means don't clone matchUpSigWithDecl name sig_tcbs sig_res_kind hs_tv_bndrs $ \ excess_sig_tcbs sig_res_kind -> @@ -2622,11 +2622,10 @@ kcCheckDeclHeader_sig sig_kind name flav -- type UF :: forall zk -> zk -> Constraint -- class UF kk (xb :: k) -- Here `k` and `kk` both denote the same variable; but only `k` is implicit - -- Hence we need to add the visible binders into dup_chk_prs + -- Hence we need to add skol_scoped_tvs ; implicit_tvs <- liftZonkM $ zonkTcTyVarsToTcTyVars implicit_tvs ; let implicit_prs = implicit_nms `zip` implicit_tvs - dup_chk_prs = implicit_prs ++ - [ (tyVarName tv, tv) | Bndr tv vis <- skol_tcbs, isVisibleTcbVis vis ] + dup_chk_prs = implicit_prs ++ mkTyVarNamePairs skol_scoped_tvs ; unless (null implicit_nms) $ -- No need if no implicit tyvars checkForDuplicateScopedTyVars dup_chk_prs ; checkForDisconnectedScopedTyVars name flav all_tcbs implicit_prs @@ -2697,6 +2696,7 @@ matchUpSigWithDecl -> ([TcTyConBinder] -> TcKind -> TcM a) -- All user-written binders are in scope -- Argument is excess TyConBinders and tail kind -> TcM ( [TcTyConBinder] -- Skolemised binders, with TcTyVars + , [TcTyVar] -- Skolem tyvars brought into lexical scope by this matching-up , a ) -- See Note [Matching a kind signature with a declaration] -- Invariant: Length of returned TyConBinders + length of excess TyConBinders @@ -2707,7 +2707,7 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside go subst tcbs [] = do { let (subst', tcbs') = substTyConBindersX subst tcbs ; res <- thing_inside tcbs' (substTy subst' sig_res_kind) - ; return ([], res) } + ; return ([], [], res) } go _ [] hs_bndrs = failWithTc (TcRnTooManyBinders sig_res_kind hs_bndrs) @@ -2724,18 +2724,21 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside subst' = extendTCvSubstWithClone subst tv tv' ; tc_hs_bndr (unLoc hs_bndr) (tyVarKind tv') ; traceTc "musd1" (ppr tcb $$ ppr hs_bndr $$ ppr tv') - ; (tcbs', res) <- tcExtendTyVarEnv [tv'] $ - go subst' tcbs' hs_bndrs' - ; return (Bndr tv' vis : tcbs', res) } + ; (tcbs', tvs, res) <- tcExtendTyVarEnv [tv'] $ + go subst' tcbs' hs_bndrs' + ; return (Bndr tv' vis : tcbs', tv':tvs, res) } + -- We do a tcExtendTyVarEnv [tv'], so we return tv' in + -- the list of lexically-scoped skolem type variables | skippable (binderFlag tcb) = -- Invisible TyConBinder, so do not consume one of the hs_bndrs do { let (subst', tcb') = substTyConBinderX subst tcb ; traceTc "musd2" (ppr tcb $$ ppr hs_bndr $$ ppr tcb') - ; (tcbs', res) <- go subst' tcbs' hs_bndrs + ; (tcbs', tvs, res) <- go subst' tcbs' hs_bndrs -- NB: pass on hs_bndrs unchanged; we do not consume a -- HsTyVarBndr for an invisible TyConBinder - ; return (tcb' : tcbs', res) } + ; return (tcb' : tcbs', tvs, res) } + -- Return `tvs`; no new lexically-scoped TyVars brought into scope | otherwise = -- At this point we conclude that: @@ -2755,9 +2758,13 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. + -- In particular: we match up if + -- (a) HsBndr looks like @k, and TyCon binder is forall k. (NamedTCB Specified) + -- (b) HsBndr looks like a, and TyCon binder is forall k -> (NamedTCB Required) + -- or k -> (AnonTCB) zippable :: TyConBndrVis -> HsBndrVis GhcRn -> Bool - zippable vis (HsBndrRequired _) = isVisibleTcbVis vis - zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis + zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis -- (a) + zippable vis (HsBndrRequired _) = isVisibleTcbVis vis -- (b) -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. @@ -3021,15 +3028,7 @@ checkForDisconnectedScopedTyVars name flav all_tcbs scoped_prs checkForDuplicateScopedTyVars :: [(Name,TcTyVar)] -> TcM () -- Check for duplicates --- E.g. data SameKind (a::k) (b::k) --- data T (a::k1) (b::k2) c = MkT (SameKind a b) c --- Here k1 and k2 start as TyVarTvs, and get unified with each other --- If this happens, things get very confused later, so fail fast --- --- In the CUSK case k1 and k2 are skolems so they won't unify; --- but in the inference case (see generaliseTcTyCon), --- and the type-sig case (see kcCheckDeclHeader_sig), they are --- TcTyVars, so we must check. +-- See Note [Aliasing in type and class declarations] checkForDuplicateScopedTyVars scoped_prs = unless (null err_prs) $ do { mapM_ report_dup err_prs; failM } @@ -3049,8 +3048,41 @@ checkForDuplicateScopedTyVars scoped_prs addErrTc $ TcRnDifferentNamesForTyVar n1 n2 -{- Note [Disconnected type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Aliasing in type and class declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data SameKind (a::k) (b::k) + data T1 (a::k1) (b::k2) c = MkT (SameKind a b) c +We do not allow this, because `k1` and `k2` would both stand for the same type +variable -- they are both aliases for `k`. + +Other examples + data T2 (a::k1) = MkT2 (SameKind a Int) -- k1 stands for Type + data T3 @k1 @k2 (a::k1) (b::k2) = MkT (SameKind a b) -- k1 and k2 are aliases + + type UF :: forall zk. zk -> Constraint + class UF @kk (xb :: k) where -- kk and k are aliases + op :: (xs::kk) -> Bool + +See #24604 for an example that crashed GHC. + +There is a design choice here. It would be possible to allow implicit type variables +like `k1` and `k2` in T1's declartion to stand for /abitrary kinds/. This is in fact +the rule we use in /terms/ pattern signatures: + f :: [Int] -> Int + f ((x::a) : xs) = ... +Here `a` stands for `Int`. But in type /signatures/ we make a different choice: + f1 :: forall (a::k1) (b::k2). SameKind a b -> blah + f2 :: forall (a::k). SameKind a Int -> blah + +Here f1's signature is rejected because `k1` and `k2` are aliased; and f2's is +rejected because `k` stands for `Int`. + +Our current choice is that type and class declarations behave more like signatures; +we do not allow aliasing. That is what `checkForDuplicateScopedTyVars` checks. + +Note [Disconnected type variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This note applies when kind-checking the header of a type/class decl that has a separate, standalone kind signature. See #24083. ===================================== testsuite/tests/saks/should_compile/all.T ===================================== @@ -13,10 +13,10 @@ test('saks014', normal, compile, ['']) test('saks015', normal, compile, ['']) test('saks016', normal, compile, ['']) test('saks017', normal, compile, ['']) -test('saks018', normal, compile, ['']) +test('saks018', normal, compile_fail, ['']) test('saks019', normal, compile, ['']) test('saks020', normal, compile, ['']) -test('saks021', normal, compile, ['']) +test('saks021', normal, compile_fail, ['']) test('saks023', normal, ghci_script, ['saks023.script']) test('saks024', normal, compile, ['']) test('saks025', extra_files(['saks025.hs']), ghci_script, ['saks025.script']) ===================================== testsuite/tests/saks/should_compile/saks018.stderr ===================================== @@ -0,0 +1,4 @@ + +saks018.hs:9:8: error: [GHC-17370] + • Different names for the same type variable: ‘hk’ and ‘k’ + • In the data type declaration for ‘T’ ===================================== testsuite/tests/saks/should_compile/saks021.stderr ===================================== @@ -0,0 +1,4 @@ + +saks021.hs:9:8: error: [GHC-17370] + • Different names for the same type variable: ‘hk’ and ‘k’ + • In the data type declaration for ‘T’ ===================================== testsuite/tests/typecheck/should_compile/T24470b.hs ===================================== @@ -7,4 +7,4 @@ import Data.Kind import Data.Data type SynOK :: forall k. k -> Type -type SynOK @t = Proxy :: j -> Type +type SynOK @j = Proxy :: j -> Type ===================================== testsuite/tests/vdq-rta/should_fail/T24604.hs ===================================== @@ -1,6 +1,6 @@ module T24604 where -import Data.Kind (Constraint, Type) +import Data.Kind type UF :: forall zk -> zk -> Constraint class UF kk (xb :: k) where ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeAbstractions #-} + +module T24604a where + +import Data.Kind + +type UF :: forall zk. zk -> Constraint +class UF @kk (xb :: k) where + op :: (xs::kk) -> Bool ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.stderr ===================================== @@ -0,0 +1,4 @@ + +T24604a.hs:8:11: error: [GHC-17370] + • Different names for the same type variable: ‘k’ and ‘kk’ + • In the class declaration for ‘UF’ ===================================== testsuite/tests/vdq-rta/should_fail/all.T ===================================== @@ -19,3 +19,4 @@ test('T24176', normal, compile_fail, ['']) test('T23739_fail_ret', normal, compile_fail, ['']) test('T23739_fail_case', normal, compile_fail, ['']) test('T24604', normal, compile_fail, ['']) +test('T24604a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60ad6eb6b45a126f4c8f47173db40bed50ccba92 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60ad6eb6b45a126f4c8f47173db40bed50ccba92 You're receiving 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 Apr 2 15:27:44 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 11:27:44 -0400 Subject: [Git][ghc/ghc][wip/fendor/fix-thunks-name-and-ui] 2 commits: Force in_multi to avoid retaining entire hsc_env Message-ID: <660c23f06617e_2bcef2a9804444720@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/fix-thunks-name-and-ui at Glasgow Haskell Compiler / GHC Commits: 5bdc5139 by Matthew Pickering at 2024-04-02T17:27:36+02:00 Force in_multi to avoid retaining entire hsc_env - - - - - b50ffd30 by Fendor at 2024-04-02T17:27:36+02:00 Eliminate name thunk in declaration fingerprinting Thunk analysis showed that we have about 100_000 thunks (in agda and `-fwrite-simplified-core`) pointing to the name of the name decl. Forcing this thunk fixes this issue. - - - - - 2 changed files: - compiler/GHC/IfaceToCore.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -956,7 +956,7 @@ tc_iface_decl_fingerprint :: Bool -- Don't load pragmas into tc_iface_decl_fingerprint ignore_prags (_version, decl) = do { -- Populate the name cache with final versions of all -- the names associated with the decl - let main_name = ifName decl + let !main_name = ifName decl -- Typecheck the thing, lazily -- NB. Firstly, the laziness is there in case we never need the ===================================== ghc/GHCi/UI.hs ===================================== @@ -557,7 +557,8 @@ interactiveUI config srcs maybe_exprs = do -- Set to True because Prelude is implicitly imported. impDecl at ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}} hsc_env <- GHC.getSession - let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1 + let !in_multi = length (hsc_all_home_unit_ids hsc_env) > 1 + -- We force this to make sure we don't retain the hsc_env when reloading empty_cache <- liftIO newIfaceCache startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = default_progname, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34efd458aa5f7c42dc8608333d01d03900241fae...b50ffd3028952591290dd104c73dfda50756df4a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34efd458aa5f7c42dc8608333d01d03900241fae...b50ffd3028952591290dd104c73dfda50756df4a You're receiving 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 Apr 2 15:28:44 2024 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Tue, 02 Apr 2024 11:28:44 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Implement Or Patterns (#22596) Message-ID: <660c242cd009_2bcef2ba02fc46866@gitlab.mail> Sebastian Graf pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 53e282ec by David Knothe at 2024-04-02T17:28:35+02:00 Implement Or Patterns (#22596) This commit introduces a new language extension, `-XOrPatterns`, as described in GHC Proposal 522. An or-pattern `pat1; ...; patk` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. See also the summary `Note [Implmentation of OrPatterns]`. Co-Authored-By: Sebastian Graf <sgraf1337 at gmail.com> - - - - - 30 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - + docs/users_guide/exts/or_patterns.rst - docs/users_guide/exts/patterns.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53e282ec25ee368c0e50fa2fc4a5bf97e1d365df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53e282ec25ee368c0e50fa2fc4a5bf97e1d365df You're receiving 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 Apr 2 15:31:29 2024 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Tue, 02 Apr 2024 11:31:29 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Implement Or Patterns (#22596) Message-ID: <660c24d16c124_2bcef2caf32849480@gitlab.mail> Sebastian Graf pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: d7c4ba3f by David Knothe at 2024-04-02T17:31:24+02:00 Implement Or Patterns (#22596) This commit introduces a new language extension, `-XOrPatterns`, as described in GHC Proposal 522. An or-pattern `pat1; ...; patk` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. See also the summary `Note [Implmentation of OrPatterns]`. Co-Authored-By: Sebastian Graf <sgraf1337 at gmail.com> - - - - - 30 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - + docs/users_guide/exts/or_patterns.rst - docs/users_guide/exts/patterns.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7c4ba3f80dd739213e5ceb814e7a59965738414 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7c4ba3f80dd739213e5ceb814e7a59965738414 You're receiving 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 Apr 2 15:33:13 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Tue, 02 Apr 2024 11:33:13 -0400 Subject: [Git][ghc/ghc][wip/fendor/os-string-modlocation] Migrate `Finder` component to `OsPath` Message-ID: <660c25394a76d_2bcef2dcd35454081@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/os-string-modlocation at Glasgow Haskell Compiler / GHC Commits: ecc6d2a7 by Fendor at 2024-04-02T17:32:55+02:00 Migrate `Finder` component to `OsPath` For each module in a GHCi session, we keep alive one `ModLocation`. A `ModLocation` is fairly inefficiently packed, as `String`s are expensive in memory usage. While benchmarking the agda codebase, we concluded that we keep alive around 11MB of `FilePath`'s, solely retained by `ModLocation`. We provide a more densely packed encoding of `ModLocation`, by moving from `FilePath` to `OsPath`. Further, we migrate the full `Finder` component to `OsPath` to avoid unnecessary transformations. As the `Finder` component is well-encapsuled, this requires only a minimal amount of changes in other modules. Bump to haddock submodule for `ModLocation` changes. - - - - - 16 changed files: - compiler/GHC.hs - + compiler/GHC/Data/OsPath.hs - compiler/GHC/Data/Strict.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Location.hs - compiler/ghc.cabal.in - utils/haddock Changes: ===================================== compiler/GHC.hs ===================================== @@ -76,6 +76,12 @@ module GHC ( ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries, mgLookupModule, ModSummary(..), ms_mod_name, ModLocation(..), + ml_hs_file, + ml_hi_file, + ml_dyn_hi_file, + ml_obj_file, + ml_dyn_obj_file, + ml_hie_file, getModSummary, getModuleGraph, isLoaded, ===================================== compiler/GHC/Data/OsPath.hs ===================================== @@ -0,0 +1,19 @@ +module GHC.Data.OsPath + ( + -- * OsPath initialisation and transformation + OsPath + , unsafeDecodeUtf + , unsafeEncodeUtf + -- * Common utility functions + , () + , (<.>) + ) + where + +import GHC.Prelude + +import System.OsPath +import Data.Either + +unsafeDecodeUtf :: OsPath -> FilePath +unsafeDecodeUtf = fromRight (error "unsafeEncodeUtf: Internal error") . decodeUtf ===================================== compiler/GHC/Data/Strict.hs ===================================== @@ -9,8 +9,11 @@ module GHC.Data.Strict ( Maybe(Nothing, Just), fromMaybe, + GHC.Data.Strict.maybe, Pair(And), - + expectJust, + fromLazy, + toLazy, -- Not used at the moment: -- -- Either(Left, Right), @@ -18,9 +21,12 @@ module GHC.Data.Strict ( ) where import GHC.Prelude hiding (Maybe(..), Either(..)) +import GHC.Stack.Types + import Control.Applicative import Data.Semigroup import Data.Data +import qualified Data.Maybe as Lazy data Maybe a = Nothing | Just !a deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data) @@ -29,6 +35,10 @@ fromMaybe :: a -> Maybe a -> a fromMaybe d Nothing = d fromMaybe _ (Just x) = x +maybe :: b -> (a -> b) -> Maybe a -> b +maybe d _ Nothing = d +maybe _ f (Just x) = f x + apMaybe :: Maybe (a -> b) -> Maybe a -> Maybe b apMaybe (Just f) (Just x) = Just (f x) apMaybe _ _ = Nothing @@ -37,6 +47,19 @@ altMaybe :: Maybe a -> Maybe a -> Maybe a altMaybe Nothing r = r altMaybe l _ = l +fromLazy :: Lazy.Maybe a -> Maybe a +fromLazy (Lazy.Just a) = Just a +fromLazy Lazy.Nothing = Nothing + +toLazy :: Maybe a -> Lazy.Maybe a +toLazy (Just a) = Lazy.Just a +toLazy Nothing = Lazy.Nothing + +expectJust :: HasCallStack => String -> Maybe a -> a +{-# INLINE expectJust #-} +expectJust _ (Just x) = x +expectJust err Nothing = error ("expectJust " ++ err) + instance Semigroup a => Semigroup (Maybe a) where Nothing <> b = b a <> Nothing = a ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -74,6 +74,7 @@ import GHC.Linker.Types import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Maybe +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Data.StringBuffer import GHC.Data.FastString import qualified GHC.Data.EnumSet as EnumSet @@ -772,7 +773,7 @@ summariseRequirement pn mod_name = do let PackageName pn_fs = pn let location = mkHomeModLocation2 fopts mod_name - (unpackFS pn_fs moduleNameSlashes mod_name) "hsig" + (unsafeEncodeUtf $ unpackFS pn_fs moduleNameSlashes mod_name) (unsafeEncodeUtf "hsig") env <- getBkpEnv src_hash <- liftIO $ getFileHash (bkp_filename env) @@ -855,12 +856,12 @@ hsModuleToModSummary home_keys pn hsc_src modname -- these filenames to figure out where the hi files go. -- A travesty! let location0 = mkHomeModLocation2 fopts modname - (unpackFS unit_fs + (unsafeEncodeUtf $ unpackFS unit_fs moduleNameSlashes modname) (case hsc_src of - HsigFile -> "hsig" - HsBootFile -> "hs-boot" - HsSrcFile -> "hs") + HsigFile -> unsafeEncodeUtf "hsig" + HsBootFile -> unsafeEncodeUtf "hs-boot" + HsSrcFile -> unsafeEncodeUtf "hs") -- DANGEROUS: bootifying can POISON the module finder cache let location = case hsc_src of HsBootFile -> addBootSuffixLocnOut location0 ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Driver.Ppr import GHC.Driver.Backend +import GHC.Data.OsPath import qualified GHC.Data.ShortText as ST import GHC.Data.Stream ( Stream ) import qualified GHC.Data.Stream as Stream @@ -259,7 +260,7 @@ outputForeignStubs Maybe FilePath) -- C file created outputForeignStubs logger tmpfs dflags unit_state mod location stubs = do - let stub_h = mkStubPaths (initFinderOpts dflags) (moduleName mod) location + let stub_h = unsafeDecodeUtf $ mkStubPaths (initFinderOpts dflags) (moduleName mod) location stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" case stubs of ===================================== compiler/GHC/Driver/Config/Finder.hs ===================================== @@ -5,30 +5,31 @@ module GHC.Driver.Config.Finder ( import GHC.Prelude +import qualified GHC.Data.Strict as Strict import GHC.Driver.DynFlags import GHC.Unit.Finder.Types import GHC.Data.FastString - +import GHC.Data.OsPath -- | Create a new 'FinderOpts' from DynFlags. initFinderOpts :: DynFlags -> FinderOpts initFinderOpts flags = FinderOpts - { finder_importPaths = importPaths flags + { finder_importPaths = fmap unsafeEncodeUtf $ importPaths flags , finder_lookupHomeInterfaces = isOneShot (ghcMode flags) , finder_bypassHiFileCheck = MkDepend == (ghcMode flags) , finder_ways = ways flags , finder_enableSuggestions = gopt Opt_HelpfulErrors flags - , finder_workingDirectory = workingDirectory flags + , finder_workingDirectory = fmap unsafeEncodeUtf $ Strict.fromLazy $ workingDirectory flags , finder_thisPackageName = mkFastString <$> thisPackageName flags , finder_hiddenModules = hiddenModules flags , finder_reexportedModules = reexportedModules flags - , finder_hieDir = hieDir flags - , finder_hieSuf = hieSuf flags - , finder_hiDir = hiDir flags - , finder_hiSuf = hiSuf_ flags - , finder_dynHiSuf = dynHiSuf_ flags - , finder_objectDir = objectDir flags - , finder_objectSuf = objectSuf_ flags - , finder_dynObjectSuf = dynObjectSuf_ flags - , finder_stubDir = stubDir flags + , finder_hieDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hieDir flags + , finder_hieSuf = unsafeEncodeUtf $ hieSuf flags + , finder_hiDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hiDir flags + , finder_hiSuf = unsafeEncodeUtf $ hiSuf_ flags + , finder_dynHiSuf = unsafeEncodeUtf $ dynHiSuf_ flags + , finder_objectDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ objectDir flags + , finder_objectSuf = unsafeEncodeUtf $ objectSuf_ flags + , finder_dynObjectSuf = unsafeEncodeUtf $ dynObjectSuf_ flags + , finder_stubDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ stubDir flags } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -264,6 +264,8 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString import GHC.Data.Bag +import GHC.Data.OsPath (unsafeEncodeUtf) +import qualified GHC.Data.Strict as Strict import GHC.Data.StringBuffer import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) @@ -2106,12 +2108,12 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs rawCmms return stub_c_exists where - no_loc = ModLocation{ ml_hs_file = Just original_filename, - ml_hi_file = panic "hscCompileCmmFile: no hi file", - ml_obj_file = panic "hscCompileCmmFile: no obj file", - ml_dyn_obj_file = panic "hscCompileCmmFile: no dyn obj file", - ml_dyn_hi_file = panic "hscCompileCmmFile: no dyn obj file", - ml_hie_file = panic "hscCompileCmmFile: no hie file"} + no_loc = ModLocation{ ml_hs_file_ = Strict.Just $ unsafeEncodeUtf original_filename, + ml_hi_file_ = panic "hscCompileCmmFile: no hi file", + ml_obj_file_ = panic "hscCompileCmmFile: no obj file", + ml_dyn_obj_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_dyn_hi_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_hie_file_ = panic "hscCompileCmmFile: no hie file"} -------------------- Stuff for new code gen --------------------- @@ -2346,12 +2348,12 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do {- Desugar it -} -- We use a basically null location for iNTERACTIVE - let iNTERACTIVELoc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hsDeclsWithLocation:ml_hi_file", - ml_obj_file = panic "hsDeclsWithLocation:ml_obj_file", - ml_dyn_obj_file = panic "hsDeclsWithLocation:ml_dyn_obj_file", - ml_dyn_hi_file = panic "hsDeclsWithLocation:ml_dyn_hi_file", - ml_hie_file = panic "hsDeclsWithLocation:ml_hie_file" } + let iNTERACTIVELoc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hsDeclsWithLocation:ml_hi_file", + ml_obj_file_ = panic "hsDeclsWithLocation:ml_obj_file", + ml_dyn_obj_file_ = panic "hsDeclsWithLocation:ml_dyn_obj_file", + ml_dyn_hi_file_ = panic "hsDeclsWithLocation:ml_dyn_hi_file", + ml_hie_file_ = panic "hsDeclsWithLocation:ml_hie_file" } ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv {- Simplify -} @@ -2630,12 +2632,12 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- Lint if necessary -} lintInteractiveExpr (text "hscCompileCoreExpr") hsc_env prepd_expr - let this_loc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file", - ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file", - ml_dyn_obj_file = panic "hscCompileCoreExpr': ml_obj_file", - ml_dyn_hi_file = panic "hscCompileCoreExpr': ml_dyn_hi_file", - ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } + let this_loc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hscCompileCoreExpr':ml_hi_file", + ml_obj_file_ = panic "hscCompileCoreExpr':ml_obj_file", + ml_dyn_obj_file_ = panic "hscCompileCoreExpr': ml_obj_file", + ml_dyn_hi_file_ = panic "hscCompileCoreExpr': ml_dyn_hi_file", + ml_hie_file_ = panic "hscCompileCoreExpr':ml_hie_file" } -- Ensure module uniqueness by giving it a name like "GhciNNNN". -- This uniqueness is needed by the JS linker. Without it we break the 1-1 ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -72,10 +72,12 @@ import GHC.Iface.Load ( cannotFindModule ) import GHC.IfaceToCore ( typecheckIface ) import GHC.Iface.Recomp ( RecompileRequired(..), CompileReason(..) ) +import qualified GHC.Data.Strict as Strict import GHC.Data.Bag ( listToBag ) import GHC.Data.Graph.Directed import GHC.Data.FastString import GHC.Data.Maybe ( expectJust ) +import GHC.Data.OsPath ( unsafeEncodeUtf, unsafeDecodeUtf ) import GHC.Data.StringBuffer import qualified GHC.LanguageExtensions as LangExt @@ -336,12 +338,15 @@ warnMissingHomeModules dflags targets mod_graph = -> moduleName (ms_mod mod) == name && tuid == ms_unitid mod TargetFile target_file _ - | Just mod_file <- ml_hs_file (ms_location mod) + | Strict.Just mod_file <- ml_hs_file_ (ms_location mod) -> - augmentByWorkingDirectory dflags target_file == mod_file || + let + target_os_file = unsafeEncodeUtf target_file + in + augmentByWorkingDirectory dflags target_file == unsafeDecodeUtf mod_file || -- Don't warn on B.hs-boot if B.hs is specified (#16551) - addBootSuffix target_file == mod_file || + addBootSuffix target_os_file == mod_file || -- We can get a file target even if a module name was -- originally specified in a command line because it can @@ -1830,7 +1835,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf let dyn_tn = tn -<.> dynsuf addFilesToClean tmpfs dynLife [dyn_tn] - return (tn, dyn_tn) + return (unsafeEncodeUtf tn, unsafeEncodeUtf dyn_tn) -- We don't want to create .o or .hi files unless we have been asked -- to by the user. But we need them, so we patch their locations in -- the ModSummary with temporary files. @@ -1839,8 +1844,8 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- If ``-fwrite-interface` is specified, then the .o and .hi files -- are written into `-odir` and `-hidir` respectively. #16670 if gopt Opt_WriteInterface dflags - then return ((ml_hi_file ms_location, ml_dyn_hi_file ms_location) - , (ml_obj_file ms_location, ml_dyn_obj_file ms_location)) + then return ((ml_hi_file_ ms_location, ml_dyn_hi_file_ ms_location) + , (ml_obj_file_ ms_location, ml_dyn_obj_file_ ms_location)) else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) let new_dflags = case enable_spec of @@ -1849,10 +1854,10 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} let ms' = ms { ms_location = - ms_location { ml_hi_file = hi_file - , ml_obj_file = o_file - , ml_dyn_hi_file = dyn_hi_file - , ml_dyn_obj_file = dyn_o_file } + ms_location { ml_hi_file_ = hi_file + , ml_obj_file_ = o_file + , ml_dyn_hi_file_ = dyn_hi_file + , ml_dyn_obj_file_ = dyn_o_file } , ms_hspp_opts = updOptLevel 0 $ new_dflags } -- Recursive call to catch the other cases @@ -2037,7 +2042,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf let fopts = initFinderOpts (hsc_dflags hsc_env) -- Make a ModLocation for this file - let location = mkHomeModLocation fopts pi_mod_name src_fn + let location = mkHomeModLocation fopts pi_mod_name (unsafeEncodeUtf src_fn) -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Driver.Env import GHC.Driver.Errors.Types import qualified GHC.SysTools as SysTools import GHC.Data.Graph.Directed ( SCC(..) ) +import GHC.Data.OsPath (unsafeDecodeUtf) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SourceError @@ -297,7 +298,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do Found loc _ -- Home package: just depend on the .hi or hi-boot file | isJust (ml_hs_file loc) || include_pkg_deps - -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc))) + -> return (Just (unsafeDecodeUtf $ addBootSuffix_maybe is_boot (ml_hi_file_ loc))) -- Not in this package: we don't need a dependency | otherwise ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -58,6 +58,7 @@ import GHC.Iface.Make import GHC.Driver.Config.Parser import GHC.Parser.Header import GHC.Data.StringBuffer +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Types.SourceError import GHC.Unit.Finder import Data.IORef @@ -759,7 +760,7 @@ mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO Mod mkOneShotModLocation pipe_env dflags src_flavour mod_name = do let PipeEnv{ src_basename=basename, src_suffix=suff } = pipe_env - let location1 = mkHomeModLocation2 fopts mod_name basename suff + let location1 = mkHomeModLocation2 fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff) -- Boot-ify it if necessary let location2 @@ -771,11 +772,11 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do -- This can't be done in mkHomeModuleLocation because -- it only applies to the module being compiles let ohi = outputHi dflags - location3 | Just fn <- ohi = location2{ ml_hi_file = fn } + location3 | Just fn <- ohi = location2{ ml_hi_file_ = unsafeEncodeUtf fn } | otherwise = location2 let dynohi = dynOutputHi dflags - location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file = fn } + location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file_ = unsafeEncodeUtf fn } | otherwise = location3 -- Take -o into account if present @@ -789,10 +790,10 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do location5 | Just ofile <- expl_o_file , let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file , isNoLink (ghcLink dflags) - = location4 { ml_obj_file = ofile - , ml_dyn_obj_file = dyn_ofile } + = location4 { ml_obj_file_ = unsafeEncodeUtf ofile + , ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | Just dyn_ofile <- expl_dyn_o_file - = location4 { ml_dyn_obj_file = dyn_ofile } + = location4 { ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | otherwise = location4 return location5 where ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Utils.Panic.Plain import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Data.Maybe +import GHC.Data.OsPath import GHC.Prelude import GHC.Unit import GHC.Unit.Env @@ -55,13 +56,13 @@ cantFindInstalledErr unit_state mhome_unit profile mod_name find_result InstalledNotFound files mb_pkg | Just pkg <- mb_pkg , notHomeUnitId mhome_unit pkg - -> not_found_in_package pkg files + -> not_found_in_package pkg $ fmap unsafeDecodeUtf files | null files -> NotAModule | otherwise - -> CouldntFindInFiles files + -> CouldntFindInFiles $ fmap unsafeDecodeUtf files _ -> panic "cantFindInstalledErr" ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -42,6 +42,9 @@ import GHC.Platform.Ways import GHC.Builtin.Names ( gHC_PRIM ) +import qualified GHC.Data.Strict as Strict +import GHC.Data.OsPath + import GHC.Unit.Env import GHC.Unit.Types import GHC.Unit.Module @@ -49,7 +52,6 @@ import GHC.Unit.Home import GHC.Unit.State import GHC.Unit.Finder.Types -import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.ShortText as ST import GHC.Utils.Misc @@ -61,8 +63,7 @@ import GHC.Types.PkgQual import GHC.Fingerprint import Data.IORef -import System.Directory -import System.FilePath +import System.Directory.OsPath import Control.Monad import Data.Time import qualified Data.Map as M @@ -70,9 +71,10 @@ import GHC.Driver.Env ( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env) ) import GHC.Driver.Config.Finder import qualified Data.Set as Set +import qualified System.OsPath as OsPath -type FileExt = String -- Filename extension -type BaseName = String -- Basename of file +type FileExt = OsPath -- Filename extension +type BaseName = OsPath -- Basename of file -- ----------------------------------------------------------------------------- -- The Finder @@ -286,7 +288,7 @@ findLookupResult fc fopts r = case r of -- implicit locations from the instances InstalledFound loc _ -> return (Found loc m) InstalledNoPackage _ -> return (NoPackage (moduleUnit m)) - InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m) + InstalledNotFound fp _ -> return (NotFound{ fr_paths = fmap unsafeDecodeUtf fp, fr_pkg = Just (moduleUnit m) , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_unusables = [] @@ -357,7 +359,7 @@ findHomeModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -382,7 +384,7 @@ findHomePackageModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkModule uid mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -413,22 +415,22 @@ findInstalledHomeModule fc fopts home_unit mod_name = do let maybe_working_dir = finder_workingDirectory fopts home_path = case maybe_working_dir of - Nothing -> finder_importPaths fopts - Just fp -> augmentImports fp (finder_importPaths fopts) + Strict.Nothing -> finder_importPaths fopts + Strict.Just fp -> augmentImports fp (finder_importPaths fopts) hi_dir_path = case finder_hiDir fopts of - Just hiDir -> case maybe_working_dir of - Nothing -> [hiDir] - Just fp -> [fp hiDir] - Nothing -> home_path + Strict.Just hiDir -> case maybe_working_dir of + Strict.Nothing -> [hiDir] + Strict.Just fp -> [fp hiDir] + Strict.Nothing -> home_path hisuf = finder_hiSuf fopts mod = mkModule home_unit mod_name source_exts = - [ ("hs", mkHomeModLocationSearched fopts mod_name "hs") - , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs") - , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig") - , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig") + [ (unsafeEncodeUtf "hs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hs") + , (unsafeEncodeUtf "lhs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhs") + , (unsafeEncodeUtf "hsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hsig") + , (unsafeEncodeUtf "lhsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhsig") ] -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that @@ -453,9 +455,9 @@ findInstalledHomeModule fc fopts home_unit mod_name = do else searchPathExts search_dirs mod exts -- | Prepend the working directory to the search path. -augmentImports :: FilePath -> [FilePath] -> [FilePath] +augmentImports :: OsPath -> [OsPath] -> [OsPath] augmentImports _work_dir [] = [] -augmentImports work_dir (fp:fps) | isAbsolute fp = fp : augmentImports work_dir fps +augmentImports work_dir (fp:fps) | OsPath.isAbsolute fp = fp : augmentImports work_dir fps | otherwise = (work_dir fp) : augmentImports work_dir fps -- | Search for a module in external packages only. @@ -488,14 +490,14 @@ findPackageModule_ fc fopts mod pkg_conf = do tag = waysBuildTag (finder_ways fopts) -- hi-suffix for packages depends on the build tag. - package_hisuf | null tag = "hi" - | otherwise = tag ++ "_hi" + package_hisuf | null tag = unsafeEncodeUtf $ "hi" + | otherwise = unsafeEncodeUtf $ tag ++ "_hi" - package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" + package_dynhisuf = unsafeEncodeUtf $ waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf package_dynhisuf - import_dirs = map ST.unpack $ unitImportDirs pkg_conf + import_dirs = map (unsafeEncodeUtf . ST.unpack) $ unitImportDirs pkg_conf -- we never look for a .hi-boot file in an external package; -- .hi-boot files only make sense for the home package. in @@ -503,7 +505,7 @@ findPackageModule_ fc fopts mod pkg_conf = do [one] | finder_bypassHiFileCheck fopts -> -- there's only one place that this .hi file can be, so -- don't bother looking for it. - let basename = moduleNameSlashes (moduleName mod) + let basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) loc = mk_hi_loc one basename in return $ InstalledFound loc mod _otherwise -> @@ -512,24 +514,24 @@ findPackageModule_ fc fopts mod pkg_conf = do -- ----------------------------------------------------------------------------- -- General path searching -searchPathExts :: [FilePath] -- paths to search +searchPathExts :: [OsPath] -- paths to search -> InstalledModule -- module name -> [ ( FileExt, -- suffix - FilePath -> BaseName -> ModLocation -- action + OsPath -> BaseName -> ModLocation -- action ) ] -> IO InstalledFindResult searchPathExts paths mod exts = search to_search where - basename = moduleNameSlashes (moduleName mod) + basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) - to_search :: [(FilePath, ModLocation)] + to_search :: [(OsPath, ModLocation)] to_search = [ (file, fn path basename) | path <- paths, (ext,fn) <- exts, - let base | path == "." = basename + let base | path == unsafeEncodeUtf "." = basename | otherwise = path basename file = base <.> ext ] @@ -543,7 +545,7 @@ searchPathExts paths mod exts = search to_search else search rest mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt - -> FilePath -> BaseName -> ModLocation + -> OsPath -> BaseName -> ModLocation mkHomeModLocationSearched fopts mod suff path basename = mkHomeModLocation2 fopts mod (path basename) suff @@ -581,18 +583,18 @@ mkHomeModLocationSearched fopts mod suff path basename = -- ext -- The filename extension of the source file (usually "hs" or "lhs"). -mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation +mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> ModLocation mkHomeModLocation dflags mod src_filename = - let (basename,extension) = splitExtension src_filename + let (basename,extension) = OsPath.splitExtension src_filename in mkHomeModLocation2 dflags mod basename extension mkHomeModLocation2 :: FinderOpts -> ModuleName - -> FilePath -- Of source module, without suffix - -> String -- Suffix + -> OsPath -- Of source module, without suffix + -> OsPath -- Suffix -> ModLocation mkHomeModLocation2 fopts mod src_basename ext = - let mod_basename = moduleNameSlashes mod + let mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod obj_fn = mkObjPath fopts src_basename mod_basename dyn_obj_fn = mkDynObjPath fopts src_basename mod_basename @@ -600,72 +602,72 @@ mkHomeModLocation2 fopts mod src_basename ext = dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename hie_fn = mkHiePath fopts src_basename mod_basename - in (ModLocation{ ml_hs_file = Just (src_basename <.> ext), - ml_hi_file = hi_fn, - ml_dyn_hi_file = dyn_hi_fn, - ml_obj_file = obj_fn, - ml_dyn_obj_file = dyn_obj_fn, - ml_hie_file = hie_fn }) + in (ModLocation{ ml_hs_file_ = Strict.Just (src_basename <.> ext), + ml_hi_file_ = hi_fn, + ml_dyn_hi_file_ = dyn_hi_fn, + ml_obj_file_ = obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, + ml_hie_file_ = hie_fn }) mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName - -> FilePath + -> OsPath -> BaseName -> ModLocation mkHomeModHiOnlyLocation fopts mod path basename = - let loc = mkHomeModLocation2 fopts mod (path basename) "" - in loc { ml_hs_file = Nothing } + let loc = mkHomeModLocation2 fopts mod (path basename) mempty + in loc { ml_hs_file_ = Strict.Nothing } -- This function is used to make a ModLocation for a package module. Hence why -- we explicitly pass in the interface file suffixes. -mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String +mkHiOnlyModLocation :: FinderOpts -> OsPath -> OsPath -> OsPath -> OsPath -> ModLocation mkHiOnlyModLocation fopts hisuf dynhisuf path basename = let full_basename = path basename obj_fn = mkObjPath fopts full_basename basename dyn_obj_fn = mkDynObjPath fopts full_basename basename hie_fn = mkHiePath fopts full_basename basename - in ModLocation{ ml_hs_file = Nothing, - ml_hi_file = full_basename <.> hisuf, + in ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = full_basename <.> hisuf, -- Remove the .hi-boot suffix from -- hi_file, if it had one. We always -- want the name of the real .hi file -- in the ml_hi_file field. - ml_dyn_obj_file = dyn_obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, -- MP: TODO - ml_dyn_hi_file = full_basename <.> dynhisuf, - ml_obj_file = obj_fn, - ml_hie_file = hie_fn + ml_dyn_hi_file_ = full_basename <.> dynhisuf, + ml_obj_file_ = obj_fn, + ml_hie_file_ = hie_fn } -- | Constructs the filename of a .o file for a given source file. -- Does /not/ check whether the .o file exists mkObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath -mkObjPath fopts basename mod_basename = obj_basename <.> osuf + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath +mkObjPath fopts basename mod_basename = obj_basename OsPath.<.> osuf where odir = finder_objectDir fopts osuf = finder_objectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir OsPath. mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_o file for a given source file. -- Does /not/ check whether the .dyn_o file exists mkDynObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf where odir = finder_objectDir fopts dynosuf = finder_dynObjectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir mod_basename | otherwise = basename @@ -673,45 +675,45 @@ mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf -- Does /not/ check whether the .hi file exists mkHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiPath fopts basename mod_basename = hi_basename <.> hisuf where hidir = finder_hiDir fopts hisuf = finder_hiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_hi file for a given source file. -- Does /not/ check whether the .dyn_hi file exists mkDynHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf where hidir = finder_hiDir fopts dynhisuf = finder_dynHiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .hie file for a given source file. -- Does /not/ check whether the .hie file exists mkHiePath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf where hiedir = finder_hieDir fopts hiesuf = finder_hieSuf fopts - hie_basename | Just dir <- hiedir = dir mod_basename + hie_basename | Strict.Just dir <- hiedir = dir mod_basename | otherwise = basename @@ -726,23 +728,23 @@ mkStubPaths :: FinderOpts -> ModuleName -> ModLocation - -> FilePath + -> OsPath mkStubPaths fopts mod location = let stubdir = finder_stubDir fopts - mod_basename = moduleNameSlashes mod - src_basename = dropExtension $ expectJust "mkStubPaths" - (ml_hs_file location) + mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod + src_basename = OsPath.dropExtension $ Strict.expectJust "mkStubPaths" + (ml_hs_file_ location) stub_basename0 - | Just dir <- stubdir = dir mod_basename + | Strict.Just dir <- stubdir = dir mod_basename | otherwise = src_basename - stub_basename = stub_basename0 ++ "_stub" + stub_basename = stub_basename0 `mappend` unsafeEncodeUtf "_stub" in - stub_basename <.> "h" + stub_basename <.> unsafeEncodeUtf "h" -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -9,6 +9,7 @@ where import GHC.Prelude import GHC.Unit +import qualified GHC.Data.Strict as Strict import qualified Data.Map as M import GHC.Fingerprint import GHC.Platform.Ways @@ -16,6 +17,7 @@ import GHC.Platform.Ways import Data.IORef import GHC.Data.FastString import qualified Data.Set as Set +import System.OsPath (OsPath) -- | The 'FinderCache' maps modules to the result of -- searching for that module. It records the results of searching for @@ -31,7 +33,7 @@ data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState) data InstalledFindResult = InstalledFound ModLocation InstalledModule | InstalledNoPackage UnitId - | InstalledNotFound [FilePath] (Maybe UnitId) + | InstalledNotFound [OsPath] (Maybe UnitId) -- | The result of searching for an imported module. -- @@ -70,7 +72,7 @@ data FindResult -- -- Should be taken from 'DynFlags' via 'initFinderOpts'. data FinderOpts = FinderOpts - { finder_importPaths :: [FilePath] + { finder_importPaths :: [OsPath] -- ^ Where are we allowed to look for Modules and Source files , finder_lookupHomeInterfaces :: Bool -- ^ When looking up a home module: @@ -88,17 +90,17 @@ data FinderOpts = FinderOpts , finder_enableSuggestions :: Bool -- ^ If we encounter unknown modules, should we suggest modules -- that have a similar name. - , finder_workingDirectory :: Maybe FilePath + , finder_workingDirectory :: Strict.Maybe OsPath , finder_thisPackageName :: Maybe FastString , finder_hiddenModules :: Set.Set ModuleName , finder_reexportedModules :: Set.Set ModuleName - , finder_hieDir :: Maybe FilePath - , finder_hieSuf :: String - , finder_hiDir :: Maybe FilePath - , finder_hiSuf :: String - , finder_dynHiSuf :: String - , finder_objectDir :: Maybe FilePath - , finder_objectSuf :: String - , finder_dynObjectSuf :: String - , finder_stubDir :: Maybe FilePath + , finder_hieDir :: Strict.Maybe OsPath + , finder_hieSuf :: OsPath + , finder_hiDir :: Strict.Maybe OsPath + , finder_hiSuf :: OsPath + , finder_dynHiSuf :: OsPath + , finder_objectDir :: Strict.Maybe OsPath + , finder_objectSuf :: OsPath + , finder_dynObjectSuf :: OsPath + , finder_stubDir :: Strict.Maybe OsPath } deriving Show ===================================== compiler/GHC/Unit/Module/Location.hs ===================================== @@ -7,13 +7,24 @@ module GHC.Unit.Module.Location , addBootSuffixLocn , addBootSuffixLocnOut , removeBootSuffix + , ml_hs_file + , ml_hi_file + , ml_dyn_hi_file + , ml_obj_file + , ml_dyn_obj_file + , ml_hie_file ) where import GHC.Prelude + +import GHC.Data.OsPath +import qualified GHC.Data.Strict as Strict import GHC.Unit.Types import GHC.Utils.Outputable +import System.OsPath + -- | Module Location -- -- Where a module lives on the file system: the actual locations @@ -39,30 +50,30 @@ import GHC.Utils.Outputable data ModLocation = ModLocation { - ml_hs_file :: Maybe FilePath, + ml_hs_file_ :: Strict.Maybe OsPath, -- ^ The source file, if we have one. Package modules -- probably don't have source files. - ml_hi_file :: FilePath, + ml_hi_file_ :: OsPath, -- ^ Where the .hi file is, whether or not it exists -- yet. Always of form foo.hi, even if there is an -- hi-boot file (we add the -boot suffix later) - ml_dyn_hi_file :: FilePath, + ml_dyn_hi_file_ :: OsPath, -- ^ Where the .dyn_hi file is, whether or not it exists -- yet. - ml_obj_file :: FilePath, + ml_obj_file_ :: OsPath, -- ^ Where the .o file is, whether or not it exists yet. -- (might not exist either because the module hasn't -- been compiled yet, or because it is part of a -- unit with a .a file) - ml_dyn_obj_file :: FilePath, + ml_dyn_obj_file_ :: OsPath, -- ^ Where the .dy file is, whether or not it exists -- yet. - ml_hie_file :: FilePath + ml_hie_file_ :: OsPath -- ^ Where the .hie file is, whether or not it exists -- yet. } deriving Show @@ -71,8 +82,8 @@ instance Outputable ModLocation where ppr = text . show -- | Add the @-boot@ suffix to .hs, .hi and .o files -addBootSuffix :: FilePath -> FilePath -addBootSuffix path = path ++ "-boot" +addBootSuffix :: OsPath -> OsPath +addBootSuffix path = path `mappend` unsafeEncodeUtf "-boot" -- | Remove the @-boot@ suffix to .hs, .hi and .o files removeBootSuffix :: FilePath -> FilePath @@ -82,7 +93,7 @@ removeBootSuffix [] = error "removeBootSuffix: no -boot suffix" -- | Add the @-boot@ suffix if the @Bool@ argument is @True@ -addBootSuffix_maybe :: IsBootInterface -> FilePath -> FilePath +addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath addBootSuffix_maybe is_boot path = case is_boot of IsBoot -> addBootSuffix path NotBoot -> path @@ -95,22 +106,42 @@ addBootSuffixLocn_maybe is_boot locn = case is_boot of -- | Add the @-boot@ suffix to all file paths associated with the module addBootSuffixLocn :: ModLocation -> ModLocation addBootSuffixLocn locn - = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn) - , ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) } + = locn { ml_hs_file_ = fmap addBootSuffix (ml_hs_file_ locn) + , ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } -- | Add the @-boot@ suffix to all output file paths associated with the -- module, not including the input file itself addBootSuffixLocnOut :: ModLocation -> ModLocation addBootSuffixLocnOut locn - = locn { ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) + = locn { ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } +-- ---------------------------------------------------------------------------- +-- Helpers for backwards compatibility +-- ---------------------------------------------------------------------------- + +ml_hs_file :: ModLocation -> Maybe FilePath +ml_hs_file = fmap unsafeDecodeUtf . Strict.toLazy . ml_hs_file_ + +ml_hi_file :: ModLocation -> FilePath +ml_hi_file = unsafeDecodeUtf . ml_hi_file_ + +ml_dyn_hi_file :: ModLocation -> FilePath +ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ + +ml_obj_file :: ModLocation -> FilePath +ml_obj_file = unsafeDecodeUtf . ml_obj_file_ + +ml_dyn_obj_file :: ModLocation -> FilePath +ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ +ml_hie_file :: ModLocation -> FilePath +ml_hie_file = unsafeDecodeUtf . ml_hie_file_ ===================================== compiler/ghc.cabal.in ===================================== @@ -428,6 +428,7 @@ Library GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList + GHC.Data.OsPath GHC.Data.Pair GHC.Data.SmallArray GHC.Data.Stream ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe +Subproject commit 1ef6c187b31f85dfd7133b150b211ec9140cc84a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecc6d2a7c69f99e28e39145fd75b4b099008c68c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecc6d2a7c69f99e28e39145fd75b4b099008c68c You're receiving 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 Apr 2 15:42:27 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 02 Apr 2024 11:42:27 -0400 Subject: [Git][ghc/ghc][wip/T24604] 3 commits: EPA: Extend StringLiteral range to include trailing commas Message-ID: <660c2763de1be_f9dac32443275@gitlab.mail> Simon Peyton Jones pushed to branch wip/T24604 at Glasgow Haskell Compiler / GHC Commits: 00d3ecf0 by Alan Zimmerman at 2024-03-29T12:19:10+00:00 EPA: Extend StringLiteral range to include trailing commas This goes slightly against the exact printing philosophy where trailing decorations should be in an annotation, but the practicalities of adding it to the WarningTxt environment, and the problems caused by deviating do not make a more principles approach worthwhile. - - - - - efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - 91bb3ee0 by Simon Peyton Jones at 2024-04-02T16:42:00+01:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - 17 changed files: - compiler/GHC/Parser.y - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/saks/should_compile/saks018.hs - testsuite/tests/saks/should_compile/saks021.hs - testsuite/tests/saks/should_fail/all.T - + testsuite/tests/saks/should_fail/saks018-fail.hs - + testsuite/tests/saks/should_fail/saks018-fail.stderr - + testsuite/tests/saks/should_fail/saks021-fail.hs - + testsuite/tests/saks/should_fail/saks021-fail.stderr - testsuite/tests/typecheck/should_compile/T24470b.hs - + testsuite/tests/vdq-rta/should_fail/T24604.hs - + testsuite/tests/vdq-rta/should_fail/T24604.stderr - + testsuite/tests/vdq-rta/should_fail/T24604a.hs - + testsuite/tests/vdq-rta/should_fail/T24604a.stderr - testsuite/tests/vdq-rta/should_fail/all.T - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -4559,7 +4559,8 @@ addTrailingCommaN (L anns a) span = do return (L anns' a) addTrailingCommaS :: Located StringLiteral -> EpaLocation -> Located StringLiteral -addTrailingCommaS (L l sl) span = L l (sl { sl_tc = Just (epaLocationRealSrcSpan span) }) +addTrailingCommaS (L l sl) span + = L (widenSpan l [AddEpAnn AnnComma span]) (sl { sl_tc = Just (epaLocationRealSrcSpan span) }) -- ------------------------------------- ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -63,7 +63,22 @@ underlying program (the C compiler), the set of flags passed determines the behaviour of the preprocessor, and Cpp and HsCpp behave differently. Specifically, we rely on "traditional" (pre-standard) preprocessing semantics (which most compilers expose via the `-traditional` flag) when preprocessing -Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +Haskell source. This avoids the following situations: + + * Removal of C-style comments, which are not comments in Haskell but valid + operators; + + * Errors due to an ANSI C preprocessor lexing the source and failing on + names with single quotes (TH quotes, ticked promoted constructors, + names with primes in them). + + Both of those cases may be subtle: gcc and clang permit C++-style // + comments in C code, and Data.Array and Data.Vector both export a // + operator whose type is such that a removed "comment" may leave code that + typechecks but does the wrong thing. Another example is that, since ANSI + C permits long character constants, an expression involving multiple + functions with primes in their names may not expand macros properly when + they occur between the primed functions. -} -- | Run either the Haskell preprocessor or the C preprocessor, as per the ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2569,9 +2569,11 @@ kcCheckDeclHeader_sig sig_kind name flav ; traceTc "kcCheckDeclHeader_sig {" $ vcat [ text "sig_kind:" <+> ppr sig_kind , text "sig_tcbs:" <+> ppr sig_tcbs - , text "sig_res_kind:" <+> ppr sig_res_kind ] + , text "sig_res_kind:" <+> ppr sig_res_kind + , text "implict_nms:" <+> ppr implicit_nms + , text "hs_tv_bndrs:" <+> ppr hs_tv_bndrs ] - ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, (extra_tcbs, tycon_res_kind)))) + ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, skol_scoped_tvs, (extra_tcbs, tycon_res_kind)))) <- pushLevelAndSolveEqualitiesX "kcCheckDeclHeader_sig" $ -- #16687 bindImplicitTKBndrs_Q_Tv implicit_nms $ -- Q means don't clone matchUpSigWithDecl name sig_tcbs sig_res_kind hs_tv_bndrs $ \ excess_sig_tcbs sig_res_kind -> @@ -2614,9 +2616,18 @@ kcCheckDeclHeader_sig sig_kind name flav -- Here p and q both map to the same kind variable k. We don't allow this -- so we must check that they are distinct. A similar thing happens -- in GHC.Tc.TyCl.swizzleTcTyConBinders during inference. + -- + -- With visible dependent quantification, one of the binders involved + -- may be explicit. Consider #24604 + -- type UF :: forall zk -> zk -> Constraint + -- class UF kk (xb :: k) + -- Here `k` and `kk` both denote the same variable; but only `k` is implicit + -- Hence we need to add skol_scoped_tvs ; implicit_tvs <- liftZonkM $ zonkTcTyVarsToTcTyVars implicit_tvs ; let implicit_prs = implicit_nms `zip` implicit_tvs - ; checkForDuplicateScopedTyVars implicit_prs + dup_chk_prs = implicit_prs ++ mkTyVarNamePairs skol_scoped_tvs + ; unless (null implicit_nms) $ -- No need if no implicit tyvars + checkForDuplicateScopedTyVars dup_chk_prs ; checkForDisconnectedScopedTyVars name flav all_tcbs implicit_prs -- Swizzle the Names so that the TyCon uses the user-declared implicit names @@ -2685,6 +2696,7 @@ matchUpSigWithDecl -> ([TcTyConBinder] -> TcKind -> TcM a) -- All user-written binders are in scope -- Argument is excess TyConBinders and tail kind -> TcM ( [TcTyConBinder] -- Skolemised binders, with TcTyVars + , [TcTyVar] -- Skolem tyvars brought into lexical scope by this matching-up , a ) -- See Note [Matching a kind signature with a declaration] -- Invariant: Length of returned TyConBinders + length of excess TyConBinders @@ -2695,7 +2707,7 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside go subst tcbs [] = do { let (subst', tcbs') = substTyConBindersX subst tcbs ; res <- thing_inside tcbs' (substTy subst' sig_res_kind) - ; return ([], res) } + ; return ([], [], res) } go _ [] hs_bndrs = failWithTc (TcRnTooManyBinders sig_res_kind hs_bndrs) @@ -2711,17 +2723,22 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside -- that come from the type declaration, not the kind signature subst' = extendTCvSubstWithClone subst tv tv' ; tc_hs_bndr (unLoc hs_bndr) (tyVarKind tv') - ; (tcbs', res) <- tcExtendTyVarEnv [tv'] $ - go subst' tcbs' hs_bndrs' - ; return (Bndr tv' vis : tcbs', res) } + ; traceTc "musd1" (ppr tcb $$ ppr hs_bndr $$ ppr tv') + ; (tcbs', tvs, res) <- tcExtendTyVarEnv [tv'] $ + go subst' tcbs' hs_bndrs' + ; return (Bndr tv' vis : tcbs', tv':tvs, res) } + -- We do a tcExtendTyVarEnv [tv'], so we return tv' in + -- the list of lexically-scoped skolem type variables | skippable (binderFlag tcb) = -- Invisible TyConBinder, so do not consume one of the hs_bndrs do { let (subst', tcb') = substTyConBinderX subst tcb - ; (tcbs', res) <- go subst' tcbs' hs_bndrs + ; traceTc "musd2" (ppr tcb $$ ppr hs_bndr $$ ppr tcb') + ; (tcbs', tvs, res) <- go subst' tcbs' hs_bndrs -- NB: pass on hs_bndrs unchanged; we do not consume a -- HsTyVarBndr for an invisible TyConBinder - ; return (tcb' : tcbs', res) } + ; return (tcb' : tcbs', tvs, res) } + -- Return `tvs`; no new lexically-scoped TyVars brought into scope | otherwise = -- At this point we conclude that: @@ -2735,14 +2752,19 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside = return () tc_hs_bndr (KindedTyVar _ _ (L _ hs_nm) lhs_kind) expected_kind = do { sig_kind <- tcLHsKindSig (TyVarBndrKindCtxt hs_nm) lhs_kind + ; traceTc "musd3:unifying" (ppr sig_kind $$ ppr expected_kind) ; discardResult $ -- See Note [discardResult in kcCheckDeclHeader_sig] unifyKind (Just (NameThing hs_nm)) sig_kind expected_kind } -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. + -- In particular: we match up if + -- (a) HsBndr looks like @k, and TyCon binder is forall k. (NamedTCB Specified) + -- (b) HsBndr looks like a, and TyCon binder is forall k -> (NamedTCB Required) + -- or k -> (AnonTCB) zippable :: TyConBndrVis -> HsBndrVis GhcRn -> Bool - zippable vis (HsBndrRequired _) = isVisibleTcbVis vis - zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis + zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis -- (a) + zippable vis (HsBndrRequired _) = isVisibleTcbVis vis -- (b) -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. @@ -3006,15 +3028,7 @@ checkForDisconnectedScopedTyVars name flav all_tcbs scoped_prs checkForDuplicateScopedTyVars :: [(Name,TcTyVar)] -> TcM () -- Check for duplicates --- E.g. data SameKind (a::k) (b::k) --- data T (a::k1) (b::k2) c = MkT (SameKind a b) c --- Here k1 and k2 start as TyVarTvs, and get unified with each other --- If this happens, things get very confused later, so fail fast --- --- In the CUSK case k1 and k2 are skolems so they won't unify; --- but in the inference case (see generaliseTcTyCon), --- and the type-sig case (see kcCheckDeclHeader_sig), they are --- TcTyVars, so we must check. +-- See Note [Aliasing in type and class declarations] checkForDuplicateScopedTyVars scoped_prs = unless (null err_prs) $ do { mapM_ report_dup err_prs; failM } @@ -3034,8 +3048,43 @@ checkForDuplicateScopedTyVars scoped_prs addErrTc $ TcRnDifferentNamesForTyVar n1 n2 -{- Note [Disconnected type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Aliasing in type and class declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data SameKind (a::k) (b::k) + data T1 (a::k1) (b::k2) c = MkT (SameKind a b) c +We do not allow this, because `k1` and `k2` would both stand for the same type +variable -- they are both aliases for `k`. + +Other examples + data T2 (a::k1) = MkT2 (SameKind a Int) -- k1 stands for Type + data T3 @k1 @k2 (a::k1) (b::k2) = MkT (SameKind a b) -- k1 and k2 are aliases + + type UF :: forall zk. zk -> Constraint + class UF @kk (xb :: k) where -- kk and k are aliases + op :: (xs::kk) -> Bool + +See #24604 for an example that crashed GHC. + +There is a design choice here. It would be possible to allow implicit type variables +like `k1` and `k2` in T1's declartion to stand for /abitrary kinds/. This is in fact +the rule we use in /terms/ pattern signatures: + f :: [Int] -> Int + f ((x::a) : xs) = ... +Here `a` stands for `Int`. But in type /signatures/ we make a different choice: + f1 :: forall (a::k1) (b::k2). SameKind a b -> blah + f2 :: forall (a::k). SameKind a Int -> blah + +Here f1's signature is rejected because `k1` and `k2` are aliased; and f2's is +rejected because `k` stands for `Int`. + +Our current choice is that type and class declarations behave more like signatures; +we do not allow aliasing. That is what `checkForDuplicateScopedTyVars` checks. +See !12328 for some design discussion. + + +Note [Disconnected type variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This note applies when kind-checking the header of a type/class decl that has a separate, standalone kind signature. See #24083. ===================================== testsuite/tests/saks/should_compile/saks018.hs ===================================== @@ -6,4 +6,4 @@ module SAKS_018 where import Data.Kind (Type) type T :: forall k -> k -> Type -data T k (x :: hk) +data T j (x :: j) ===================================== testsuite/tests/saks/should_compile/saks021.hs ===================================== @@ -6,4 +6,4 @@ module SAKS_021 where import Data.Kind (Type) type T :: forall k -> forall (xx :: k) -> Type -data T k (x :: hk) +data T j (x :: j) ===================================== testsuite/tests/saks/should_fail/all.T ===================================== @@ -36,3 +36,5 @@ test('T18863b', normal, compile_fail, ['']) test('T18863c', normal, compile_fail, ['']) test('T18863d', normal, compile_fail, ['']) test('T20916', normal, compile_fail, ['']) +test('saks018-fail', normal, compile_fail, ['']) +test('saks021-fail', normal, compile_fail, ['']) ===================================== testsuite/tests/saks/should_fail/saks018-fail.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE PolyKinds, ExplicitForAll #-} + +module SAKS_018 where + +import Data.Kind (Type) + +type T :: forall k -> k -> Type +data T k (x :: hk) ===================================== testsuite/tests/saks/should_fail/saks018-fail.stderr ===================================== @@ -0,0 +1,4 @@ + +saks018-fail.hs:9:8: error: [GHC-17370] + • Different names for the same type variable: ‘hk’ and ‘k’ + • In the data type declaration for ‘T’ ===================================== testsuite/tests/saks/should_fail/saks021-fail.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE PolyKinds, ExplicitForAll #-} + +module SAKS_021 where + +import Data.Kind (Type) + +type T :: forall k -> forall (xx :: k) -> Type +data T k (x :: hk) ===================================== testsuite/tests/saks/should_fail/saks021-fail.stderr ===================================== @@ -0,0 +1,4 @@ + +saks021-fail.hs:9:8: error: [GHC-17370] + • Different names for the same type variable: ‘hk’ and ‘k’ + • In the data type declaration for ‘T’ ===================================== testsuite/tests/typecheck/should_compile/T24470b.hs ===================================== @@ -7,4 +7,4 @@ import Data.Kind import Data.Data type SynOK :: forall k. k -> Type -type SynOK @t = Proxy :: j -> Type +type SynOK @j = Proxy :: j -> Type ===================================== testsuite/tests/vdq-rta/should_fail/T24604.hs ===================================== @@ -0,0 +1,7 @@ +module T24604 where + +import Data.Kind + +type UF :: forall zk -> zk -> Constraint +class UF kk (xb :: k) where + op :: (xs::kk) -> Bool ===================================== testsuite/tests/vdq-rta/should_fail/T24604.stderr ===================================== @@ -0,0 +1,4 @@ + +T24604.hs:6:10: error: [GHC-17370] + • Different names for the same type variable: ‘k’ and ‘kk’ + • In the class declaration for ‘UF’ ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeAbstractions #-} + +module T24604a where + +import Data.Kind + +type UF :: forall zk. zk -> Constraint +class UF @kk (xb :: k) where + op :: (xs::kk) -> Bool ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.stderr ===================================== @@ -0,0 +1,4 @@ + +T24604a.hs:8:11: error: [GHC-17370] + • Different names for the same type variable: ‘k’ and ‘kk’ + • In the class declaration for ‘UF’ ===================================== testsuite/tests/vdq-rta/should_fail/all.T ===================================== @@ -17,4 +17,6 @@ test('T23738_fail_implicit_tv', normal, compile_fail, ['']) test('T23738_fail_var', normal, compile_fail, ['']) test('T24176', normal, compile_fail, ['']) test('T23739_fail_ret', normal, compile_fail, ['']) -test('T23739_fail_case', normal, compile_fail, ['']) \ No newline at end of file +test('T23739_fail_case', normal, compile_fail, ['']) +test('T24604', normal, compile_fail, ['']) +test('T24604a', normal, compile_fail, ['']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -652,6 +652,10 @@ printSourceText :: (Monad m, Monoid w) => SourceText -> String -> EP w m () printSourceText (NoSourceText) txt = printStringAdvance txt >> return () printSourceText (SourceText txt) _ = printStringAdvance (unpackFS txt) >> return () +printSourceTextAA :: (Monad m, Monoid w) => SourceText -> String -> EP w m () +printSourceTextAA (NoSourceText) txt = printStringAtAA (EpaDelta (SameLine 0) []) txt >> return () +printSourceTextAA (SourceText txt) _ = printStringAtAA (EpaDelta (SameLine 0) []) (unpackFS txt) >> return () + -- --------------------------------------------------------------------- printStringAtSs :: (Monad m, Monoid w) => SrcSpan -> String -> EP w m () @@ -2099,7 +2103,7 @@ instance ExactPrint StringLiteral where setAnnotationAnchor a _ _ _ = a exact l@(StringLiteral src fs mcomma) = do - printSourceText src (show (unpackFS fs)) + printSourceTextAA src (show (unpackFS fs)) mapM_ (\r -> printStringAtRs r ",") mcomma return l View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/60ad6eb6b45a126f4c8f47173db40bed50ccba92...91bb3ee04fd6fa37a0e6b8c8a0771a3640fd7f6e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/60ad6eb6b45a126f4c8f47173db40bed50ccba92...91bb3ee04fd6fa37a0e6b8c8a0771a3640fd7f6e You're receiving 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 Apr 2 15:49:00 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 02 Apr 2024 11:49:00 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 2 commits: fixup! rts: lookupSymbolInNativeObj in Windows Message-ID: <660c28ecdbea0_f9da28a4c41331a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 8a604085 by Rodrigo Mesquita at 2024-04-02T16:48:48+01:00 fixup! rts: lookupSymbolInNativeObj in Windows - - - - - 051ad35c by Rodrigo Mesquita at 2024-04-02T16:48:48+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 9 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -643,7 +643,13 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; @@ -652,7 +658,6 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,19 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { - IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1884,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,7 +1,10 @@ -#include "CheckUnload.h" -#include "ForeignExports.h" #include "LinkerInternals.h" #include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" #include "RtsUtils.h" #include "Profiling.h" @@ -208,4 +211,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1141,47 +1141,55 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent); + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name STG_UNUSED, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+1,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96fb179d5fd008bdf4a1ef87a2e49a6e35452ccf...051ad35c2a4a9e855892038e4d22f36f83842440 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96fb179d5fd008bdf4a1ef87a2e49a6e35452ccf...051ad35c2a4a9e855892038e4d22f36f83842440 You're receiving 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 Apr 2 15:59:41 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 02 Apr 2024 11:59:41 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 3 commits: rts: Make addDLL a wrapper around loadNativeObj Message-ID: <660c2b6dae46f_f9da459df4174bc@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: c5858977 by Rodrigo Mesquita at 2024-04-02T16:59:11+01:00 rts: Make addDLL a wrapper around loadNativeObj Rewrite the implementation of `addDLL` as a wrapper around the more principled `loadNativeObj` rts linker function. The latter should be preferred while the former is preserved for backwards compatibility. `loadNativeObj` was previously only available on ELF platforms, so this commit further refactors the rts linker to transform loadNativeObj_ELF into loadNativeObj_POSIX, which is available in ELF and MachO platforms. The refactor made it possible to remove the `dl_mutex` mutex in favour of always using `linker_mutex` (rather than a combination of both). Lastly, we implement `loadNativeObj` for Windows too. - - - - - 206adda7 by Rodrigo Mesquita at 2024-04-02T16:59:11+01:00 fixup! rts: lookupSymbolInNativeObj in Windows - - - - - 2befe7f0 by Rodrigo Mesquita at 2024-04-02T16:59:11+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 18 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - libraries/ghci/GHCi/ObjLink.hs - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/include/rts/Linker.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/linker/PEi386.c - rts/linker/PEi386.h - rts/rts.cabal - testsuite/tests/ghci/linking/dyn/T3372.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== libraries/ghci/GHCi/ObjLink.hs ===================================== @@ -74,7 +74,7 @@ lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a)) lookupSymbolInDLL dll str_in = do let str = prefixUnderscore str_in withCAString str $ \c_str -> do - addr <- c_lookupSymbolInDLL dll c_str + addr <- c_lookupSymbolInNativeObj dll c_str if addr == nullPtr then return Nothing else return (Just addr) @@ -112,7 +112,7 @@ loadDLL str0 = do -- (maybe_handle, maybe_errmsg) <- withFilePath (normalise str) $ \dll -> alloca $ \errmsg_ptr -> (,) - <$> c_addDLL dll errmsg_ptr + <$> c_loadNativeObj dll errmsg_ptr <*> peek errmsg_ptr if maybe_handle == nullPtr @@ -176,8 +176,8 @@ resolveObjs = do -- Foreign declarations to RTS entry points which does the real work; -- --------------------------------------------------------------------------- -foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> Ptr CString -> IO (Ptr LoadedDLL) -foreign import ccall unsafe "lookupSymbolInDLL" c_lookupSymbolInDLL :: Ptr LoadedDLL -> CString -> IO (Ptr a) +foreign import ccall unsafe "loadNativeObj" c_loadNativeObj :: CFilePath -> Ptr CString -> IO (Ptr LoadedDLL) +foreign import ccall unsafe "lookupSymbolInNativeObj" c_lookupSymbolInNativeObj :: Ptr LoadedDLL -> CString -> IO (Ptr a) foreign import ccall unsafe "initLinker_" c_initLinker_ :: CInt -> IO () foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInNativeObj) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -417,11 +421,8 @@ static int linker_init_done = 0 ; #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) static void *dl_prog_handle; -static regex_t re_invalid; -static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif +regex_t re_invalid; +regex_t re_realso; #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -556,87 +551,6 @@ exitLinker( void ) { # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -/* Suppose in ghci we load a temporary SO for a module containing - f = 1 - and then modify the module, recompile, and load another temporary - SO with - f = 2 - Then as we don't unload the first SO, dlsym will find the - f = 1 - symbol whereas we want the - f = 2 - symbol. We therefore need to keep our own SO handle list, and - try SOs in the right order. */ - -typedef - struct _OpenedSO { - struct _OpenedSO* next; - void *handle; - } - OpenedSO; - -/* A list thereof. */ -static OpenedSO* openedSOs = NULL; - -static void * -internal_dlopen(const char *dll_name, const char **errmsg_ptr) -{ - OpenedSO* o_so; - void *hdl; - - // omitted: RTLD_NOW - // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html - IF_DEBUG(linker, - debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name)); - - //-------------- Begin critical section ------------------ - // This critical section is necessary because dlerror() is not - // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008) - // Also, the error message returned must be copied to preserve it - // (see POSIX also) - - ACQUIRE_LOCK(&dl_mutex); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - if (hdl == NULL) { - /* dlopen failed; return a ptr to the error msg. */ - char *errmsg = dlerror(); - if (errmsg == NULL) errmsg = "addDLL: unknown error"; - char *errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL"); - strcpy(errmsg_copy, errmsg); - *errmsg_ptr = errmsg_copy; - } else { - o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL"); - o_so->handle = hdl; - o_so->next = openedSOs; - openedSOs = o_so; - } - - RELEASE_LOCK(&dl_mutex); - //--------------- End critical section ------------------- - - return hdl; -} - /* Note [RTLD_LOCAL] ~~~~~~~~~~~~~~~~~ @@ -657,11 +571,10 @@ internal_dlopen(const char *dll_name, const char **errmsg_ptr) static void * internal_dlsym(const char *symbol) { - OpenedSO* o_so; void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -669,20 +582,19 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } - for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) { - v = dlsym(o_so->handle, symbol); - if (dlerror() == NULL) { + for (ObjectCode *nc = loaded_objects; nc; nc = nc->next_loaded_object) { + if (nc->type == DYNAMIC_OBJECT) { + v = dlsym(nc->dlopen_handle, symbol); + if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; + } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -722,98 +634,37 @@ internal_dlsym(const char *symbol) { // we failed to find the symbol return NULL; } +# endif -void *lookupSymbolInDLL(void *handle, const char *symbol_name) +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { + ACQUIRE_LOCK(&linker_mutex); + #if defined(OBJFORMAT_MACHO) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif - - ACQUIRE_LOCK(&dl_mutex); // dlsym alters dlerror +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); - RELEASE_LOCK(&dl_mutex); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif + + RELEASE_LOCK(&linker_mutex); return result; } -# endif -void *addDLL(pathchar* dll_name, const char **errmsg_ptr) +const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - /* ------------------- ELF DLL loader ------------------- */ - -#define NMATCH 5 - regmatch_t match[NMATCH]; - void *handle; - const char *errmsg; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; - - IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name)); - handle = internal_dlopen(dll_name, &errmsg); - - if (handle != NULL) { - return handle; - } - - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg)); - result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - *errmsg_ptr = errmsg; // return original error if open fails - return NULL; - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)errmsg); // Free old message before creating new one - handle = internal_dlopen(line+match[2].rm_so, errmsg_ptr); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); + char *errmsg; + if (loadNativeObj(dll_name, &errmsg)) { + return NULL; + } else { + ASSERT(errmsg != NULL); + return errmsg; } - return handle; - -# elif defined(OBJFORMAT_PEi386) - // FIXME - return addDLL_PEi386(dll_name, NULL); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1240,10 +1091,10 @@ void freeObjectCode (ObjectCode *oc) } if (oc->type == DYNAMIC_OBJECT) { -#if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); +#if defined(OBJFORMAT_ELF) || defined(darwin_HOST_OS) + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1908,12 +1759,20 @@ HsInt purgeObj (pathchar *path) return r; } +ObjectCode *lookupObjectByPath(pathchar *path) { + for (ObjectCode *o = objects; o; o = o->next) { + if (0 == pathcmp(o->fileName, path)) { + return o; + } + } + return NULL; +} + OStatus getObjectLoadStatus_ (pathchar *path) { - for (ObjectCode *o = objects; o; o = o->next) { - if (0 == pathcmp(o->fileName, path)) { - return o->status; - } + ObjectCode *oc = lookupObjectByPath(path); + if (oc) { + return oc->status; } return OBJECT_NOT_LOADED; } @@ -2000,25 +1859,33 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) void * loadNativeObj (pathchar *path, char **errmsg) { + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); - RELEASE_LOCK(&linker_mutex); - return r; -} + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); #else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); barf("loadNativeObj: not implemented on this platform"); -} #endif -HsInt unloadNativeObj (void *handle) +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); + } +#endif + + RELEASE_LOCK(&linker_mutex); + return r; +} + +static HsInt unloadNativeObj_(void *handle) { bool unloadedAnyObj = false; @@ -2051,11 +1918,18 @@ HsInt unloadNativeObj (void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } +HsInt unloadNativeObj(void *handle) { + ACQUIRE_LOCK(&linker_mutex); + HsInt r = unloadNativeObj_(handle); + RELEASE_LOCK(&linker_mutex); + return r; +} + /* ----------------------------------------------------------------------------- * Segment management */ ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ @@ -515,9 +511,9 @@ HsInt loadArchive_ (pathchar *path); #define USE_CONTIGUOUS_MMAP 0 #endif - HsInt isAlreadyLoaded( pathchar *path ); OStatus getObjectLoadStatus_ (pathchar *path); +ObjectCode *lookupObjectByPath(pathchar *path); HsInt loadOc( ObjectCode* oc ); ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize, bool mapped, pathchar *archiveMemberName, ===================================== rts/RtsSymbols.c ===================================== @@ -619,7 +619,7 @@ extern char **environ; SymI_HasProto(purgeObj) \ SymI_HasProto(insertSymbol) \ SymI_HasProto(lookupSymbol) \ - SymI_HasProto(lookupSymbolInDLL) \ + SymI_HasProto(lookupSymbolInNativeObj) \ SymI_HasDataProto(stg_makeStablePtrzh) \ SymI_HasDataProto(stg_mkApUpd0zh) \ SymI_HasDataProto(stg_labelThreadzh) \ ===================================== rts/include/rts/Linker.h ===================================== @@ -90,10 +90,10 @@ void *loadNativeObj( pathchar *path, char **errmsg ); Takes the handle returned from loadNativeObj() as an argument. */ HsInt unloadNativeObj( void *handle ); -/* load a dynamic library */ -void *addDLL(pathchar* dll_name, const char **errmsg); +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name); -void *lookupSymbolInDLL(void *handle, const char *symbol_name); +/* load a dynamic library */ +const char *addDLL(pathchar* dll_name); /* add a path to the library search path */ HsPtr addLibrarySearchPath(pathchar* dll_path); ===================================== rts/linker/Elf.c ===================================== @@ -27,11 +27,15 @@ #include "sm/OSMem.h" #include "linker/util.h" #include "linker/elf_util.h" +#include "linker/LoadNativeObjPosix.h" +#include #include #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,159 +2073,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - /* Loading the same object multiple times will lead to chaos - * as we will have two ObjectCodes but one underlying dlopen - * handle. Fail if this happens. - */ - if (getObjectLoadStatus_(path) != OBJECT_NOT_LOADED) { - copyErrmsg(errmsg, "loadNativeObj_ELF: Already loaded"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); - nc->dlopen_handle = hdl; - foreignExportsFinishedLoadingObject(); - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2271,4 +2122,71 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +extern regex_t re_invalid; +extern regex_t re_realso; + +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex); + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,214 @@ +#include "LinkerInternals.h" +#include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + +#endif /* elf + macho */ ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/linker/PEi386.c ===================================== @@ -1141,47 +1141,55 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent); + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name STG_UNUSED, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+1,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c ===================================== testsuite/tests/ghci/linking/dyn/T3372.hs ===================================== @@ -1,3 +1,6 @@ +-- Note: This test exercises running concurrent GHCi sessions, but +-- although this test is expected to pass, running concurrent GHCi +-- sessions is currently broken in other ways; see #24345. {-# LANGUAGE MagicHash #-} module Main where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/051ad35c2a4a9e855892038e4d22f36f83842440...2befe7f0d625968b12c2e2637b3731cdeb2d1234 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/051ad35c2a4a9e855892038e4d22f36f83842440...2befe7f0d625968b12c2e2637b3731cdeb2d1234 You're receiving 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 Apr 2 16:51:06 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 02 Apr 2024 12:51:06 -0400 Subject: [Git][ghc/ghc][master] 5 commits: rts: Fix TSAN_ENABLED CPP guard Message-ID: <660c377a18c98_f9dab30970313e3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - 8 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm/ThreadSanitizer.hs - rts/TSANUtils.c - rts/include/Cmm.h - rts/include/rts/TSANUtils.h - rts/include/stg/SMP.h - rts/rts.cabal Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -339,7 +339,7 @@ flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . f flavour_string Llvm = "llvm" flavour_string Dwarf = "debug_info" flavour_string FullyStatic = "fully_static" - flavour_string ThreadSanitiser = "thread_sanitizer" + flavour_string ThreadSanitiser = "thread_sanitizer_cmm" flavour_string NoSplitSections = "no_split_sections" flavour_string BootNonmovingGc = "boot_nonmoving_gc" @@ -969,9 +969,9 @@ job_groups = , validateBuilds Amd64 (Linux Debian10) nativeInt , validateBuilds Amd64 (Linux Debian10) unreg , fastCI (validateBuilds Amd64 (Linux Debian10) debug) - , -- Nightly allowed to fail: #22520 + , -- More work is needed to address TSAN failures: #22520 modifyNightlyJobs allowFailure - (modifyValidateJobs manual tsan_jobs) + (modifyValidateJobs (allowFailure . manual) tsan_jobs) , -- Nightly allowed to fail: #22343 modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) @@ -1039,7 +1039,7 @@ job_groups = -- Haddock is large enough to make TSAN choke without massive quantities of -- memory. . addVariable "HADRIAN_ARGS" "--docs=none") $ - validateBuilds Amd64 (Linux Debian10) tsan + validateBuilds Amd64 (Linux Debian12) tsan make_wasm_jobs cfg = modifyJobs @@ -1083,6 +1083,7 @@ platform_mapping = Map.map go combined_result , "nightly-x86_64-linux-deb11-validate" , "nightly-x86_64-linux-deb12-validate" , "x86_64-linux-alpine3_18-wasm-cross_wasm32-wasi-release+fully_static" + , "x86_64-linux-deb12-validate+thread_sanitizer_cmm" , "nightly-aarch64-linux-deb10-validate" , "nightly-x86_64-linux-alpine3_12-validate" , "nightly-x86_64-linux-deb10-validate" ===================================== .gitlab/jobs.yaml ===================================== @@ -1644,18 +1644,18 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb10-validate+thread_sanitizer": { + "nightly-x86_64-linux-deb10-zstd-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], - "allow_failure": true, + "allow_failure": false, "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1698,17 +1698,15 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", - "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "HADRIAN_ARGS": "--docs=none", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", - "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", + "TEST_ENV": "x86_64-linux-deb10-zstd-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb10-zstd-validate": { + "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -1719,7 +1717,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", + "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1729,14 +1727,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-deb10-$CACHE_REV", + "key": "x86_64-linux-deb11-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -1762,15 +1760,17 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-zstd-validate", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { + "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -1781,7 +1781,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1823,18 +1823,19 @@ "x86_64-linux" ], "variables": { - "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "BIGNUM_BACKEND": "native", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", - "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", - "CROSS_TARGET": "aarch64-linux-gnu", + "CONFIGURE_WRAPPER": "emconfigure", + "CROSS_EMULATOR": "js-emulator", + "CROSS_TARGET": "javascript-unknown-ghcjs", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { + "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -1845,7 +1846,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", + "ghc-x86_64-linux-deb11-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1887,19 +1888,16 @@ "x86_64-linux" ], "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", + "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-validate": { + "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -1910,7 +1908,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb11-validate.tar.xz", + "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1953,15 +1951,15 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", - "BUILD_FLAVOUR": "validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", + "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-validate", + "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { + "nightly-x86_64-linux-deb12-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -1972,7 +1970,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", + "ghc-x86_64-linux-deb12-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -1982,14 +1980,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", + "key": "x86_64-linux-deb12-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2015,15 +2013,15 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", - "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate", + "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", - "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc", + "RUNTEST_ARGS": "", + "TEST_ENV": "x86_64-linux-deb12-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb12-validate": { + "nightly-x86_64-linux-deb12-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -2034,7 +2032,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb12-validate.tar.xz", + "ghc-x86_64-linux-deb12-validate+llvm.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -2077,26 +2075,26 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate", - "BUILD_FLAVOUR": "validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm", + "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb12-validate", + "TEST_ENV": "x86_64-linux-deb12-validate+llvm", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb12-validate+llvm": { + "nightly-x86_64-linux-deb12-validate+thread_sanitizer_cmm": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], - "allow_failure": false, + "allow_failure": true, "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb12-validate+llvm.tar.xz", + "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -2139,11 +2137,13 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm", - "BUILD_FLAVOUR": "validate+llvm", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm", + "BUILD_FLAVOUR": "validate+thread_sanitizer_cmm", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", + "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb12-validate+llvm", + "TEST_ENV": "x86_64-linux-deb12-validate+thread_sanitizer_cmm", + "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" } }, @@ -5090,7 +5090,7 @@ "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, - "x86_64-linux-deb10-validate+thread_sanitizer": { + "x86_64-linux-deb10-zstd-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -5101,7 +5101,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5127,9 +5127,8 @@ ], "rules": [ { - "allow_failure": true, - "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", - "when": "manual" + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "when": "on_success" } ], "script": [ @@ -5145,16 +5144,14 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", - "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "HADRIAN_ARGS": "--docs=none", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", - "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" + "TEST_ENV": "x86_64-linux-deb10-zstd-validate" } }, - "x86_64-linux-deb10-zstd-validate": { + "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -5165,7 +5162,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", + "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5175,14 +5172,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-deb10-$CACHE_REV", + "key": "x86_64-linux-deb11-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -5191,7 +5188,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -5208,14 +5205,16 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-zstd-validate" + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, - "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { + "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -5226,7 +5225,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5252,7 +5251,7 @@ ], "rules": [ { - "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*javascript.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -5268,17 +5267,18 @@ "x86_64-linux" ], "variables": { - "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "BIGNUM_BACKEND": "native", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", - "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", - "CROSS_TARGET": "aarch64-linux-gnu", + "CONFIGURE_WRAPPER": "emconfigure", + "CROSS_EMULATOR": "js-emulator", + "CROSS_TARGET": "javascript-unknown-ghcjs", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" + "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, - "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { + "x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -5289,7 +5289,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", + "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5315,7 +5315,7 @@ ], "rules": [ { - "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*javascript.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -5331,18 +5331,15 @@ "x86_64-linux" ], "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", - "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", + "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", + "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc" } }, - "x86_64-linux-deb11-validate+boot_nonmoving_gc": { + "x86_64-linux-deb12-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -5353,7 +5350,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", + "ghc-x86_64-linux-deb12-validate+llvm.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5363,14 +5360,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", + "key": "x86_64-linux-deb12-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -5379,7 +5376,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -5396,25 +5393,25 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", - "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm", + "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", - "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc" + "RUNTEST_ARGS": "", + "TEST_ENV": "x86_64-linux-deb12-validate+llvm" } }, - "x86_64-linux-deb12-validate+llvm": { + "x86_64-linux-deb12-validate+thread_sanitizer_cmm": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], - "allow_failure": false, + "allow_failure": true, "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb12-validate+llvm.tar.xz", + "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -5440,8 +5437,9 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", - "when": "on_success" + "allow_failure": true, + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "when": "manual" } ], "script": [ @@ -5457,11 +5455,13 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm", - "BUILD_FLAVOUR": "validate+llvm", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm", + "BUILD_FLAVOUR": "validate+thread_sanitizer_cmm", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", + "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb12-validate+llvm" + "TEST_ENV": "x86_64-linux-deb12-validate+thread_sanitizer_cmm", + "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, "x86_64-linux-fedora33-release": { ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -184,7 +184,7 @@ saveRestoreCallerRegs us platform = restore = blockFromList restore_nodes -- | Mirrors __tsan_memory_order --- +-- memoryOrderToTsanMemoryOrder :: Env -> MemoryOrdering -> CmmExpr memoryOrderToTsanMemoryOrder env mord = mkIntExpr (platform env) n @@ -294,4 +294,3 @@ tsanAtomicRMW env mord op w addr val dest = AMO_Or -> "fetch_or" AMO_Xor -> "fetch_xor" fn = fsLit $ "__tsan_atomic" ++ show (widthInBits w) ++ "_" ++ op' - ===================================== rts/TSANUtils.c ===================================== @@ -2,7 +2,7 @@ #if defined(TSAN_ENABLED) -uint64_t ghc_tsan_atomic64_compare_exchange(uint64_t *ptr, uint64_t expected, uint64_t new_value, int success_memorder, int failure_memorder) +__tsan_atomic64 ghc_tsan_atomic64_compare_exchange(volatile __tsan_atomic64 *ptr, __tsan_atomic64 expected, __tsan_atomic64 new_value, int success_memorder, int failure_memorder) { __tsan_atomic64_compare_exchange_strong( ptr, &expected, new_value, @@ -10,7 +10,7 @@ uint64_t ghc_tsan_atomic64_compare_exchange(uint64_t *ptr, uint64_t expected, ui return expected; } -uint32_t ghc_tsan_atomic32_compare_exchange(uint32_t *ptr, uint32_t expected, uint32_t new_value, int success_memorder, int failure_memorder) +__tsan_atomic32 ghc_tsan_atomic32_compare_exchange(volatile __tsan_atomic32 *ptr, __tsan_atomic32 expected, __tsan_atomic32 new_value, int success_memorder, int failure_memorder) { __tsan_atomic32_compare_exchange_strong( ptr, &expected, new_value, @@ -18,7 +18,7 @@ uint32_t ghc_tsan_atomic32_compare_exchange(uint32_t *ptr, uint32_t expected, ui return expected; } -uint16_t ghc_tsan_atomic16_compare_exchange(uint16_t *ptr, uint16_t expected, uint16_t new_value, int success_memorder, int failure_memorder) +__tsan_atomic16 ghc_tsan_atomic16_compare_exchange(volatile __tsan_atomic16 *ptr, __tsan_atomic16 expected, __tsan_atomic16 new_value, int success_memorder, int failure_memorder) { __tsan_atomic16_compare_exchange_strong( ptr, &expected, new_value, @@ -26,7 +26,7 @@ uint16_t ghc_tsan_atomic16_compare_exchange(uint16_t *ptr, uint16_t expected, ui return expected; } -uint8_t ghc_tsan_atomic8_compare_exchange(uint8_t *ptr, uint8_t expected, uint8_t new_value, int success_memorder, int failure_memorder) +__tsan_atomic8 ghc_tsan_atomic8_compare_exchange(volatile __tsan_atomic8 *ptr, __tsan_atomic8 expected, __tsan_atomic8 new_value, int success_memorder, int failure_memorder) { __tsan_atomic8_compare_exchange_strong( ptr, &expected, new_value, ===================================== rts/include/Cmm.h ===================================== @@ -698,11 +698,11 @@ #define ACQUIRE_FENCE prim %fence_acquire(); #define SEQ_CST_FENCE prim %fence_seq_cst(); -#if TSAN_ENABLED +#if defined(TSAN_ENABLED) // This is may be efficient than a fence but TSAN can reason about it. -#if WORD_SIZE_IN_BITS == 64 +#if SIZEOF_W == 8 #define ACQUIRE_FENCE_ON(x) if (1) { W_ tmp; (tmp) = prim %load_acquire64(x); } -#elif WORD_SIZE_IN_BITS == 32 +#elif SIZEOF_W == 4 #define ACQUIRE_FENCE_ON(x) if (1) { W_ tmp; (tmp) = prim %load_acquire32(x); } #endif #else ===================================== rts/include/rts/TSANUtils.h ===================================== @@ -98,10 +98,18 @@ void AnnotateBenignRaceSized(const char *file, #define TSAN_ANNOTATE_BENIGN_RACE(addr,desc) \ TSAN_ANNOTATE_BENIGN_RACE_SIZED((void*)(addr), sizeof(*addr), desc) +#if defined(TSAN_ENABLED) && defined(__clang__) +#include +#else +typedef char __tsan_atomic8; +typedef short __tsan_atomic16; +typedef int __tsan_atomic32; +typedef long __tsan_atomic64; +#endif -uint64_t ghc_tsan_atomic64_compare_exchange(uint64_t *ptr, uint64_t expected, uint64_t new_value, int success_memorder, int failure_memorder); -uint32_t ghc_tsan_atomic32_compare_exchange(uint32_t *ptr, uint32_t expected, uint32_t new_value, int success_memorder, int failure_memorder); -uint16_t ghc_tsan_atomic16_compare_exchange(uint16_t *ptr, uint16_t expected, uint16_t new_value, int success_memorder, int failure_memorder); -uint8_t ghc_tsan_atomic8_compare_exchange(uint8_t *ptr, uint8_t expected, uint8_t new_value, int success_memorder, int failure_memorder); +__tsan_atomic64 ghc_tsan_atomic64_compare_exchange(volatile __tsan_atomic64 *ptr, __tsan_atomic64 expected, __tsan_atomic64 new_value, int success_memorder, int failure_memorder); +__tsan_atomic32 ghc_tsan_atomic32_compare_exchange(volatile __tsan_atomic32 *ptr, __tsan_atomic32 expected, __tsan_atomic32 new_value, int success_memorder, int failure_memorder); +__tsan_atomic16 ghc_tsan_atomic16_compare_exchange(volatile __tsan_atomic16 *ptr, __tsan_atomic16 expected, __tsan_atomic16 new_value, int success_memorder, int failure_memorder); +__tsan_atomic8 ghc_tsan_atomic8_compare_exchange(volatile __tsan_atomic8 *ptr, __tsan_atomic8 expected, __tsan_atomic8 new_value, int success_memorder, int failure_memorder); #endif ===================================== rts/include/stg/SMP.h ===================================== @@ -549,9 +549,14 @@ busy_wait_nop(void) #define SEQ_CST_FENCE() __atomic_thread_fence(__ATOMIC_SEQ_CST) #if defined(TSAN_ENABLED) +#if !defined(__clang__) +#undef ACQUIRE_FENCE +#undef RELEASE_FENCE +#undef SEQ_CST_FENCE #define ACQUIRE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_ACQUIRE);) #define RELEASE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_RELEASE);) #define SEQ_CST_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_SEQ_CST);) +#endif #define ACQUIRE_FENCE_ON(x) (void)ACQUIRE_LOAD(x) #else #define ACQUIRE_FENCE_ON(x) __atomic_thread_fence(__ATOMIC_ACQUIRE) ===================================== rts/rts.cabal ===================================== @@ -184,7 +184,6 @@ library if flag(thread-sanitizer) cc-options: -fsanitize=thread ld-options: -fsanitize=thread - extra-libraries: tsan if os(linux) -- the RTS depends upon libc. while this dependency is generally View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efab3649b685d92b1856a62532b343ef70777612...07cb627c8232f573bd6a8ea1b7c110ff3c1b5d22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efab3649b685d92b1856a62532b343ef70777612...07cb627c8232f573bd6a8ea1b7c110ff3c1b5d22 You're receiving 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 Apr 2 16:52:06 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 02 Apr 2024 12:52:06 -0400 Subject: [Git][ghc/ghc][master] Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) Message-ID: <660c37b61ccc7_f9dad00d04361f9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - 11 changed files: - compiler/GHC/Rename/Splice.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/Language/Haskell/Syntax/Type.hs - testsuite/tests/partial-sigs/should_run/GHCiWildcardKind.stdout - + testsuite/tests/th/T24299.hs - + testsuite/tests/th/T24299.stderr - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/Rename/Splice.hs ===================================== @@ -677,7 +677,7 @@ References: [2] 'rnSpliceExpr' [3] 'GHC.Tc.Gen.Splice.qAddModFinalizer' [4] 'GHC.Tc.Gen.Expr.tcExpr' ('HsSpliceE' ('HsSpliced' ...)) -[5] 'GHC.Tc.Gen.HsType.tc_hs_type' ('HsSpliceTy' ('HsSpliced' ...)) +[5] 'GHC.Tc.Gen.HsType.tcHsType' ('HsSpliceTy' ('HsSpliced' ...)) [6] 'GHC.Tc.Gen.Pat.tc_pat' ('SplicePat' ('HsSpliced' ...)) -} ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -1678,7 +1678,7 @@ tcRhs (TcPatBind infos pat' mult mult_ann grhss pat_ty) -- is generated so that multiplicity can be inferred. tcMultAnn :: HsMultAnn GhcRn -> TcM Mult tcMultAnn (HsPct1Ann _) = return oneDataConTy -tcMultAnn (HsMultAnn _ p) = tcCheckLHsType p (TheKind multiplicityTy) +tcMultAnn (HsMultAnn _ p) = tcCheckLHsTypeInContext p (TheKind multiplicityTy) tcMultAnn (HsNoMultAnn _) = newFlexiTyVarTy multiplicityTy tcExtendTyVarEnvForRhs :: Maybe TcIdSigInst -> TcM a -> TcM a ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -56,7 +56,7 @@ module GHC.Tc.Gen.HsType ( tcHsLiftedType, tcHsOpenType, tcHsLiftedTypeNC, tcHsOpenTypeNC, tcInferLHsType, tcInferLHsTypeKind, tcInferLHsTypeUnsaturated, - tcCheckLHsType, + tcCheckLHsTypeInContext, tcHsContext, tcLHsPredType, kindGeneralizeAll, @@ -397,7 +397,7 @@ kcClassSigType names sig_ty@(L _ (HsSig { sig_bndrs = hs_outer_bndrs, sig_body = hs_ty })) = addSigCtxt (funsSigCtxt names) sig_ty $ do { _ <- bindOuterSigTKBndrs_Tv hs_outer_bndrs $ - tcLHsType hs_ty liftedTypeKind + tcCheckLHsType hs_ty liftedTypeKind ; return () } tcClassSigType :: [LocatedN Name] -> LHsSigType GhcRn -> TcM Type @@ -467,7 +467,7 @@ tc_lhs_sig_type skol_info full_hs_ty@(L loc (HsSig { sig_bndrs = hs_outer_bndrs do { exp_kind <- newExpectedKind ctxt_kind -- See Note [Escaping kind in type signatures] ; stuff <- tcOuterTKBndrs skol_info hs_outer_bndrs $ - tcLHsType hs_ty exp_kind + tcCheckLHsType hs_ty exp_kind ; return (exp_kind, stuff) } -- Default any unconstrained variables free in the kind @@ -609,7 +609,7 @@ tc_top_lhs_type tyki ctxt (L loc sig_ty@(HsSig { sig_bndrs = hs_outer_bndrs <- pushLevelAndSolveEqualitiesX "tc_top_lhs_type" $ tcOuterTKBndrs skol_info hs_outer_bndrs $ do { kind <- newExpectedKind (expectedKindInCtxt ctxt) - ; tc_lhs_type (mkMode tyki) body kind } + ; tc_check_lhs_type (mkMode tyki) body kind } ; outer_bndrs <- scopedSortOuter outer_bndrs ; let outer_tv_bndrs = outerTyVarBndrs outer_bndrs @@ -704,7 +704,7 @@ tcHsTypeApp wc_ty kind -- We are looking at a user-written type, very like a -- signature so we want to solve its equalities right now bindNamedWildCardBinders sig_wcs $ \ _ -> - tc_lhs_type mode hs_ty kind + tc_check_lhs_type mode hs_ty kind -- We do not kind-generalize type applications: we just -- instantiate with exactly what the user says. @@ -720,7 +720,7 @@ tcHsTypeApp wc_ty kind ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A HsWildCardBndrs's hswc_ext now only includes /named/ wildcards, so any unnamed wildcards stay unchanged in hswc_body. When called in -tcHsTypeApp, tcCheckLHsType will call emitAnonTypeHole +tcHsTypeApp, tcCheckLHsTypeInContext will call emitAnonTypeHole on these anonymous wildcards. However, this would trigger error/warning when an anonymous wildcard is passed in as a visible type argument, which we do not want because users should be able to write @@ -790,10 +790,10 @@ We work this out in a hacky way, by looking at the expected kind: see Note [Inferring tuple kinds]. In this case, we kind-check the RHS using the kind gotten from the LHS: -see the call to tcCheckLHsType in tcTyFamInstEqnGuts in GHC.Tc.Tycl. +see the call to tcCheckLHsTypeInContext in tcTyFamInstEqnGuts in GHC.Tc.Tycl. But we want the kind from the LHS to be /zonked/, so that when -kind-checking the RHS (tcCheckLHsType) we can "see" what we learned +kind-checking the RHS (tcCheckLHsTypeInContext) we can "see" what we learned from kind-checking the LHS (tcFamTyPats). In our example above, the type of the LHS is just `kappa` (by instantiating the forall k), but then we learn (from x::Constraint) that kappa ~ Constraint. We want @@ -821,15 +821,15 @@ tcHsOpenType, tcHsLiftedType, tcHsOpenType hs_ty = addTypeCtxt hs_ty $ tcHsOpenTypeNC hs_ty tcHsLiftedType hs_ty = addTypeCtxt hs_ty $ tcHsLiftedTypeNC hs_ty -tcHsOpenTypeNC hs_ty = do { ek <- newOpenTypeKind; tcLHsType hs_ty ek } -tcHsLiftedTypeNC hs_ty = tcLHsType hs_ty liftedTypeKind +tcHsOpenTypeNC hs_ty = do { ek <- newOpenTypeKind; tcCheckLHsType hs_ty ek } +tcHsLiftedTypeNC hs_ty = tcCheckLHsType hs_ty liftedTypeKind --- Like tcHsType, but takes an expected kind -tcCheckLHsType :: LHsType GhcRn -> ContextKind -> TcM TcType -tcCheckLHsType hs_ty exp_kind +-- Like tcCheckLHsType, but takes an expected kind +tcCheckLHsTypeInContext :: LHsType GhcRn -> ContextKind -> TcM TcType +tcCheckLHsTypeInContext hs_ty exp_kind = addTypeCtxt hs_ty $ do { ek <- newExpectedKind exp_kind - ; tcLHsType hs_ty ek } + ; tcCheckLHsType hs_ty ek } tcInferLHsType :: LHsType GhcRn -> TcM TcType tcInferLHsType hs_ty @@ -854,7 +854,7 @@ tcInferLHsTypeUnsaturated :: LHsType GhcRn -> TcM (TcType, TcKind) tcInferLHsTypeUnsaturated hs_ty = addTypeCtxt hs_ty $ do { mode <- mkHoleMode TypeLevel HM_Sig -- Allow and report holes - ; case splitHsAppTys (unLoc hs_ty) of + ; case splitHsAppTys_maybe (unLoc hs_ty) of Just (hs_fun_ty, hs_args) -> do { (fun_ty, _ki) <- tcInferTyAppHead mode hs_fun_ty ; tcInferTyApps_nosat mode hs_fun_ty fun_ty hs_args } @@ -890,12 +890,18 @@ Terms are eagerly instantiated. This means that if you say x = id then `id` gets instantiated to have type alpha -> alpha. The variable -alpha is then unconstrained and regeneralized. But we cannot do this -in types, as we have no type-level lambda. So, when we are sure -that we will not want to regeneralize later -- because we are done -checking a type, for example -- we can instantiate. But we do not -instantiate at variables, nor do we in tcInferLHsTypeUnsaturated, -which is used by :kind in GHCi. +alpha is then unconstrained and regeneralized. So we may well end up with + x = /\x. id @a +But we cannot do this in types, as we have no type-level lambda. + +So, we must be careful only to instantiate at the last possible moment, when +we're sure we're never going to want the lost polymorphism again. This is done +in calls to `tcInstInvisibleTyBinders`; a particular case in point is in +`checkExpectedKind`. + +Otherwise, we are careful /not/ to instantiate. For example: +* at a variable in `tcTyVar` +* in `tcInferLHsTypeUnsaturated`, which is used by :kind in GHCi. ************************************************************************ * * @@ -969,48 +975,18 @@ instance Outputable TcTyMode where {- Note [Bidirectional type checking] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In expressions, whenever we see a polymorphic identifier, say `id`, we are -free to instantiate it with metavariables, knowing that we can always -re-generalize with type-lambdas when necessary. For example: - - rank2 :: (forall a. a -> a) -> () - x = rank2 id - -When checking the body of `x`, we can instantiate `id` with a metavariable. -Then, when we're checking the application of `rank2`, we notice that we really -need a polymorphic `id`, and then re-generalize over the unconstrained -metavariable. - -In types, however, we're not so lucky, because *we cannot re-generalize*! -There is no lambda. So, we must be careful only to instantiate at the last -possible moment, when we're sure we're never going to want the lost polymorphism -again. This is done in calls to tcInstInvisibleTyBinders. - -To implement this behavior, we use bidirectional type checking, where we -explicitly think about whether we know the kind of the type we're checking -or not. Note that there is a difference between not knowing a kind and -knowing a metavariable kind: the metavariables are TauTvs, and cannot become -forall-quantified kinds. Previously (before dependent types), there were -no higher-rank kinds, and so we could instantiate early and be sure that -no types would have polymorphic kinds, and so we could always assume that -the kind of a type was a fresh metavariable. Not so anymore, thus the -need for two algorithms. - -For HsType forms that can never be kind-polymorphic, we implement only the -"down" direction, where we safely assume a metavariable kind. For HsType forms -that *can* be kind-polymorphic, we implement just the "up" (functions with -"infer" in their name) version, as we gain nothing by also implementing the -"down" version. - -Note [Future-proofing the type checker] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As discussed in Note [Bidirectional type checking], each HsType form is -handled in *either* tc_infer_hs_type *or* tc_hs_type. These functions -are mutually recursive, so that either one can work for any type former. -But, we want to make sure that our pattern-matches are complete. So, -we have a bunch of repetitive code just so that we get warnings if we're -missing any patterns. +In types, as in terms, we use bidirectional type infefence. The main workhorse +function looks like this: + type ExpKind = ExpType + data ExpType = Check TcSigmaKind | Infer ...(hole TcRhoType)... + + tcHsType :: TcTyMode -> HsType GhcRn -> ExpKind -> TcM TcType + +* When the `ExpKind` argument is (Check ki), we /check/ that the type has + kind `ki` +* When the `ExpKind` argument is (Infer hole), we /infer/ the kind of the + type, and fill the hole with that kind -} ------------------------------------------ @@ -1022,74 +998,13 @@ tc_infer_lhs_type mode (L span ty) = setSrcSpanA span $ tc_infer_hs_type mode ty ---------------------------- --- | Call 'tc_infer_hs_type' and check its result against an expected kind. -tc_infer_hs_type_ek :: HasDebugCallStack => TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType -tc_infer_hs_type_ek mode hs_ty ek - = do { (ty, k) <- tc_infer_hs_type mode hs_ty - ; checkExpectedKind hs_ty ty k ek } - --------------------------- -- | Infer the kind of a type and desugar. This is the "up" type-checker, -- as described in Note [Bidirectional type checking] tc_infer_hs_type :: TcTyMode -> HsType GhcRn -> TcM (TcType, TcKind) -tc_infer_hs_type mode (HsParTy _ t) - = tc_infer_lhs_type mode t - -tc_infer_hs_type mode ty - | Just (hs_fun_ty, hs_args) <- splitHsAppTys ty - = do { (fun_ty, _ki) <- tcInferTyAppHead mode hs_fun_ty - ; tcInferTyApps mode hs_fun_ty fun_ty hs_args } - -tc_infer_hs_type mode (HsKindSig _ ty sig) - = do { let mode' = mode { mode_tyki = KindLevel } - ; sig' <- tc_lhs_kind_sig mode' KindSigCtxt sig - -- We must typecheck the kind signature, and solve all - -- its equalities etc; from this point on we may do - -- things like instantiate its foralls, so it needs - -- to be fully determined (#14904) - ; traceTc "tc_infer_hs_type:sig" (ppr ty $$ ppr 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 --- the splice location to the typechecker. Here we skip over it in order to have --- the same kind inferred for a given expression whether it was produced from --- splices or not. --- --- See Note [Delaying modFinalizers in untyped splices]. -tc_infer_hs_type mode (HsSpliceTy (HsUntypedSpliceTop _ ty) _) - = tc_infer_lhs_type mode ty - -tc_infer_hs_type _ (HsSpliceTy (HsUntypedSpliceNested n) s) = pprPanic "tc_infer_hs_type: invalid nested splice" (pprUntypedSplice True (Just n) s) - -tc_infer_hs_type mode (HsDocTy _ ty _) = tc_infer_lhs_type mode ty - --- See Note [Typechecking HsCoreTys] -tc_infer_hs_type _ (XHsType ty) - = do env <- getLclEnv - -- Raw uniques since we go from NameEnv to TvSubstEnv. - let subst_prs :: [(Unique, TcTyVar)] - subst_prs = [ (getUnique nm, tv) - | ATyVar nm tv <- nonDetNameEnvElts (getLclEnvTypeEnv env) ] - subst = mkTvSubst - (mkInScopeSetList $ map snd subst_prs) - (listToUFM_Directly $ map (fmap mkTyVarTy) subst_prs) - ty' = substTy subst ty - return (ty', typeKind ty') - -tc_infer_hs_type _ (HsExplicitListTy _ _ tys) - | null tys -- this is so that we can use visible kind application with '[] - -- e.g ... '[] @Bool - = return (mkTyConTy promotedNilDataCon, - mkSpecForAllTys [alphaTyVar] $ mkListTy alphaTy) - -tc_infer_hs_type mode other_ty - = do { kv <- newMetaKindVar - ; ty' <- tc_hs_type mode other_ty kv - ; return (ty', kv) } +tc_infer_hs_type mode rn_ty + = tcInfer $ \exp_kind -> tcHsType mode rn_ty exp_kind {- Note [Typechecking HsCoreTys] @@ -1133,26 +1048,36 @@ substitution to each HsCoreTy and all is well: -} ------------------------------------------ -tcLHsType :: LHsType GhcRn -> TcKind -> TcM TcType -tcLHsType hs_ty exp_kind - = tc_lhs_type typeLevelMode hs_ty exp_kind +tcCheckLHsType :: LHsType GhcRn -> TcKind -> TcM TcType +tcCheckLHsType hs_ty exp_kind + = tc_check_lhs_type typeLevelMode hs_ty exp_kind + +tc_check_lhs_type :: TcTyMode -> LHsType GhcRn -> TcKind -> TcM TcType +tc_check_lhs_type mode (L span ty) exp_kind + = setSrcSpanA span $ + tc_check_hs_type mode ty exp_kind -tc_lhs_type :: TcTyMode -> LHsType GhcRn -> TcKind -> TcM TcType -tc_lhs_type mode (L span ty) exp_kind +tc_check_hs_type :: TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType +-- See Note [Bidirectional type checking] +tc_check_hs_type mode ty ek = tcHsType mode ty (Check ek) + +tcLHsType :: TcTyMode -> LHsType GhcRn -> ExpKind -> TcM TcType +tcLHsType mode (L span ty) exp_kind = setSrcSpanA span $ - tc_hs_type mode ty exp_kind + tcHsType mode ty exp_kind -tc_hs_type :: TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType +tcHsType :: TcTyMode -> HsType GhcRn -> ExpKind -> TcM TcType +-- The main workhorse for type kind checking -- See Note [Bidirectional type checking] -tc_hs_type mode (HsParTy _ ty) exp_kind = tc_lhs_type mode ty exp_kind -tc_hs_type mode (HsDocTy _ ty _) exp_kind = tc_lhs_type mode ty exp_kind -tc_hs_type _ ty@(HsBangTy _ bang _) _ +tcHsType mode (HsParTy _ ty) exp_kind = tcLHsType mode ty exp_kind +tcHsType mode (HsDocTy _ ty _) exp_kind = tcLHsType mode ty exp_kind +tcHsType _ ty@(HsBangTy _ bang _) _ -- While top-level bangs at this point are eliminated (eg !(Maybe Int)), -- other kinds of bangs are not (eg ((!Maybe) Int)). These kinds of -- bangs are invalid, so fail. (#7210, #14761) = failWith $ TcRnUnexpectedAnnotation ty bang -tc_hs_type _ ty@(HsRecTy {}) _ +tcHsType _ ty@(HsRecTy {}) _ -- Record types (which only show up temporarily in constructor -- signatures) should have been removed by now = failWithTc $ TcRnIllegalRecordSyntax (Right ty) @@ -1162,23 +1087,23 @@ tc_hs_type _ ty@(HsRecTy {}) _ -- while capturing the local environment. -- -- See Note [Delaying modFinalizers in untyped splices]. -tc_hs_type mode (HsSpliceTy (HsUntypedSpliceTop mod_finalizers ty) _) +tcHsType mode (HsSpliceTy (HsUntypedSpliceTop mod_finalizers ty) _) exp_kind = do addModFinalizersWithLclEnv mod_finalizers - tc_lhs_type mode ty exp_kind + tcLHsType mode ty exp_kind -tc_hs_type _ (HsSpliceTy (HsUntypedSpliceNested n) s) _ = pprPanic "tc_hs_type: invalid nested splice" (pprUntypedSplice True (Just n) s) +tcHsType _ (HsSpliceTy (HsUntypedSpliceNested n) s) _ = pprPanic "tcHsType: invalid nested splice" (pprUntypedSplice True (Just n) s) ---------- Functions and applications -tc_hs_type mode (HsFunTy _ mult ty1 ty2) exp_kind +tcHsType mode (HsFunTy _ mult ty1 ty2) exp_kind = tc_fun_type mode mult ty1 ty2 exp_kind -tc_hs_type mode (HsOpTy _ _ ty1 (L _ op) ty2) exp_kind +tcHsType mode (HsOpTy _ _ ty1 (L _ op) ty2) exp_kind | op `hasKey` unrestrictedFunTyConKey = tc_fun_type mode (HsUnrestrictedArrow noExtField) ty1 ty2 exp_kind --------- Foralls -tc_hs_type mode t@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind +tcHsType mode t@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind | HsForAllInvis{} <- tele = tc_hs_forall_ty tele ty exp_kind -- For an invisible forall, we allow the body to have @@ -1187,15 +1112,15 @@ tc_hs_type mode t@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind | HsForAllVis{} <- tele = do { ek <- newOpenTypeKind - ; r <- tc_hs_forall_ty tele ty ek - ; checkExpectedKind t r ek exp_kind } + ; r <- tc_hs_forall_ty tele ty (Check ek) + ; checkExpKind t r ek exp_kind } -- For a visible forall, we require that the body is of kind TYPE r. -- See Note [Body kind of a HsForAllTy] where tc_hs_forall_ty tele ty ek = do { (tv_bndrs, ty') <- tcTKTelescope mode tele $ - tc_lhs_type mode ty ek + tcLHsType mode ty ek -- Pass on the mode from the type, to any wildcards -- in kind signatures on the forall'd variables -- e.g. f :: _ -> Int -> forall (a :: _). blah @@ -1203,145 +1128,196 @@ tc_hs_type mode t@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind -- Do not kind-generalise here! See Note [Kind generalisation] ; return (mkForAllTys tv_bndrs ty') } -tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind +tcHsType mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind | null (unLoc ctxt) - = tc_lhs_type mode rn_ty exp_kind - - -- See Note [Body kind of a HsQualTy] - | isConstraintLikeKind exp_kind + = tcLHsType mode rn_ty exp_kind + -- See Note [Body kind of a HsQualTy] + | Check kind <- exp_kind, isConstraintLikeKind kind = do { ctxt' <- tc_hs_context mode ctxt - ; ty' <- tc_lhs_type mode rn_ty constraintKind - ; return (tcMkDFunPhiTy ctxt' ty') } + ; ty' <- tc_check_lhs_type mode rn_ty constraintKind + ; return (tcMkDFunPhiTy ctxt' ty') } | otherwise = do { ctxt' <- tc_hs_context mode ctxt - ; ek <- newOpenTypeKind -- The body kind (result of the function) can + ; ek <- newOpenTypeKind -- The body kind (result of the function) can -- be TYPE r, for any r, hence newOpenTypeKind - ; ty' <- tc_lhs_type mode rn_ty ek - ; checkExpectedKind (unLoc rn_ty) (tcMkPhiTy ctxt' ty') - liftedTypeKind exp_kind } + ; ty' <- tc_check_lhs_type mode rn_ty ek + ; let res_ty = tcMkPhiTy ctxt' ty' + ; checkExpKind (unLoc rn_ty) res_ty + liftedTypeKind exp_kind } --------- Lists, arrays, and tuples -tc_hs_type mode rn_ty@(HsListTy _ elt_ty) exp_kind - = do { tau_ty <- tc_lhs_type mode elt_ty liftedTypeKind +tcHsType mode rn_ty@(HsListTy _ elt_ty) exp_kind + = do { tau_ty <- tc_check_lhs_type mode elt_ty liftedTypeKind ; checkWiredInTyCon listTyCon - ; checkExpectedKind rn_ty (mkListTy tau_ty) liftedTypeKind exp_kind } + ; checkExpKind rn_ty (mkListTy tau_ty) liftedTypeKind exp_kind } --- See Note [Distinguishing tuple kinds] in Language.Haskell.Syntax.Type --- See Note [Inferring tuple kinds] -tc_hs_type mode rn_ty@(HsTupleTy _ HsBoxedOrConstraintTuple hs_tys) exp_kind - -- (NB: not zonking before looking at exp_k, to avoid left-right bias) - | Just tup_sort <- tupKindSort_maybe exp_kind - = traceTc "tc_hs_type tuple" (ppr hs_tys) >> - tc_tuple rn_ty mode tup_sort hs_tys exp_kind - | otherwise - = do { traceTc "tc_hs_type tuple 2" (ppr hs_tys) - ; (tys, kinds) <- mapAndUnzipM (tc_infer_lhs_type mode) hs_tys - ; kinds <- liftZonkM $ mapM zonkTcType kinds - -- Infer each arg type separately, because errors can be - -- confusing if we give them a shared kind. Eg #7410 - -- (Either Int, Int), we do not want to get an error saying - -- "the second argument of a tuple should have kind *->*" +tcHsType mode rn_ty@(HsTupleTy _ tup_sort tys) exp_kind + = do k <- expTypeToType exp_kind + tc_hs_tuple_ty rn_ty mode tup_sort tys k - ; let (arg_kind, tup_sort) - = case [ (k,s) | k <- kinds - , Just s <- [tupKindSort_maybe k] ] of - ((k,s) : _) -> (k,s) - [] -> (liftedTypeKind, BoxedTuple) - -- In the [] case, it's not clear what the kind is, so guess * - - ; tys' <- sequence [ setSrcSpanA loc $ - checkExpectedKind hs_ty ty kind arg_kind - | ((L loc hs_ty),ty,kind) <- zip3 hs_tys tys kinds ] - - ; finish_tuple rn_ty tup_sort tys' (map (const arg_kind) tys') exp_kind } - - -tc_hs_type mode rn_ty@(HsTupleTy _ HsUnboxedTuple tys) exp_kind - = tc_tuple rn_ty mode UnboxedTuple tys exp_kind - -tc_hs_type mode rn_ty@(HsSumTy _ hs_tys) exp_kind +tcHsType mode rn_ty@(HsSumTy _ hs_tys) exp_kind = do { let arity = length hs_tys ; arg_kinds <- mapM (\_ -> newOpenTypeKind) hs_tys - ; tau_tys <- zipWithM (tc_lhs_type mode) hs_tys arg_kinds + ; tau_tys <- zipWithM (tc_check_lhs_type mode) hs_tys arg_kinds ; let arg_reps = map kindRep arg_kinds arg_tys = arg_reps ++ tau_tys sum_ty = mkTyConApp (sumTyCon arity) arg_tys sum_kind = unboxedSumKind arg_reps - ; checkExpectedKind rn_ty sum_ty sum_kind exp_kind + ; checkExpKind rn_ty sum_ty sum_kind exp_kind } --------- Promoted lists and tuples -tc_hs_type mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind - -- The '[] case is handled in tc_infer_hs_type. - -- See Note [Future-proofing the type checker]. +tcHsType mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind + -- See Note [Kind-checking explicit lists] + | null tys - = tc_infer_hs_type_ek mode rn_ty exp_kind + = do let ty = mkTyConTy promotedNilDataCon + let kind = mkSpecForAllTys [alphaTyVar] $ mkListTy alphaTy + checkExpKind rn_ty ty kind exp_kind | otherwise = do { tks <- mapM (tc_infer_lhs_type mode) tys ; (taus', kind) <- unifyKinds tys tks ; let ty = (foldr (mk_cons kind) (mk_nil kind) taus') - ; checkExpectedKind rn_ty ty (mkListTy kind) exp_kind } + ; checkExpKind rn_ty ty (mkListTy kind) exp_kind } where mk_cons k a b = mkTyConApp (promoteDataCon consDataCon) [k, a, b] mk_nil k = mkTyConApp (promoteDataCon nilDataCon) [k] -tc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind +tcHsType mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind -- using newMetaKindVar means that we force instantiations of any polykinded -- types. At first, I just used tc_infer_lhs_type, but that led to #11255. = do { ks <- replicateM arity newMetaKindVar - ; taus <- zipWithM (tc_lhs_type mode) tys ks + ; taus <- zipWithM (tc_check_lhs_type mode) tys ks ; let kind_con = tupleTyCon Boxed arity ty_con = promotedTupleDataCon Boxed arity tup_k = mkTyConApp kind_con ks ; checkTupSize arity - ; checkExpectedKind rn_ty (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind } + ; checkExpKind rn_ty (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind } where arity = length tys --------- Constraint types -tc_hs_type mode rn_ty@(HsIParamTy _ (L _ n) ty) exp_kind +tcHsType mode rn_ty@(HsIParamTy _ (L _ n) ty) exp_kind = do { massert (isTypeLevel (mode_tyki mode)) - ; ty' <- tc_lhs_type mode ty liftedTypeKind + ; ty' <- tc_check_lhs_type mode ty liftedTypeKind ; let n' = mkStrLitTy $ hsIPNameFS n ; ipClass <- tcLookupClass ipClassName - ; checkExpectedKind rn_ty (mkClassPred ipClass [n',ty']) + ; checkExpKind rn_ty (mkClassPred ipClass [n',ty']) constraintKind exp_kind } -tc_hs_type _ rn_ty@(HsStarTy _ _) exp_kind +tcHsType _ rn_ty@(HsStarTy _ _) exp_kind -- Desugaring 'HsStarTy' to 'Data.Kind.Type' here means that we don't -- have to handle it in 'coreView' - = checkExpectedKind rn_ty liftedTypeKind liftedTypeKind exp_kind + = checkExpKind rn_ty liftedTypeKind liftedTypeKind exp_kind --------- Literals -tc_hs_type _ rn_ty@(HsTyLit _ (HsNumTy _ n)) exp_kind +tcHsType _ rn_ty@(HsTyLit _ (HsNumTy _ n)) exp_kind = do { checkWiredInTyCon naturalTyCon - ; checkExpectedKind rn_ty (mkNumLitTy n) naturalTy exp_kind } + ; checkExpKind rn_ty (mkNumLitTy n) naturalTy exp_kind } -tc_hs_type _ rn_ty@(HsTyLit _ (HsStrTy _ s)) exp_kind +tcHsType _ rn_ty@(HsTyLit _ (HsStrTy _ s)) exp_kind = do { checkWiredInTyCon typeSymbolKindCon - ; checkExpectedKind rn_ty (mkStrLitTy s) typeSymbolKind exp_kind } -tc_hs_type _ rn_ty@(HsTyLit _ (HsCharTy _ c)) exp_kind + ; checkExpKind rn_ty (mkStrLitTy s) typeSymbolKind exp_kind } +tcHsType _ rn_ty@(HsTyLit _ (HsCharTy _ c)) exp_kind = do { checkWiredInTyCon charTyCon - ; checkExpectedKind rn_ty (mkCharLitTy c) charTy exp_kind } + ; checkExpKind rn_ty (mkCharLitTy c) charTy exp_kind } --------- Wildcards -tc_hs_type mode ty@(HsWildCardTy _) ek - = tcAnonWildCardOcc NoExtraConstraint mode ty ek +tcHsType mode ty@(HsWildCardTy _) ek + = do k <- expTypeToType ek + tcAnonWildCardOcc NoExtraConstraint mode ty k + +--------- Type applications +tcHsType mode rn_ty@(HsTyVar{}) exp_kind = tc_app_ty mode rn_ty exp_kind +tcHsType mode rn_ty@(HsAppTy{}) exp_kind = tc_app_ty mode rn_ty exp_kind +tcHsType mode rn_ty@(HsAppKindTy{}) exp_kind = tc_app_ty mode rn_ty exp_kind +tcHsType mode rn_ty@(HsOpTy{}) exp_kind = tc_app_ty mode rn_ty exp_kind + +tcHsType mode rn_ty@(HsKindSig _ ty sig) exp_kind + = do { let mode' = mode { mode_tyki = KindLevel } + ; sig' <- tc_lhs_kind_sig mode' KindSigCtxt sig + -- We must typecheck the kind signature, and solve all + -- its equalities etc; from this point on we may do + -- things like instantiate its foralls, so it needs + -- to be fully determined (#14904) + ; traceTc "tcHsType:sig" (ppr ty $$ ppr sig') + ; ty' <- tcAddKindSigPlaceholders sig $ + tc_check_lhs_type mode ty sig' + ; checkExpKind rn_ty ty' sig' exp_kind } + +-- See Note [Typechecking HsCoreTys] +tcHsType _ rn_ty@(XHsType ty) exp_kind + = do env <- getLclEnv + -- Raw uniques since we go from NameEnv to TvSubstEnv. + let subst_prs :: [(Unique, TcTyVar)] + subst_prs = [ (getUnique nm, tv) + | ATyVar nm tv <- nonDetNameEnvElts (getLclEnvTypeEnv env) ] + subst = mkTvSubst + (mkInScopeSetList $ map snd subst_prs) + (listToUFM_Directly $ map (fmap mkTyVarTy) subst_prs) + ty' = substTy subst ty + checkExpKind rn_ty ty' (typeKind ty') exp_kind + +tc_hs_tuple_ty :: HsType GhcRn + -> TcTyMode + -> HsTupleSort + -> [LHsType GhcRn] + -> TcKind + -> TcM TcType +-- See Note [Distinguishing tuple kinds] in GHC.Hs.Type +-- See Note [Inferring tuple kinds] +tc_hs_tuple_ty rn_ty mode HsBoxedOrConstraintTuple hs_tys exp_kind + -- (NB: not zonking before looking at exp_k, to avoid left-right bias) + | Just tup_sort <- tupKindSort_maybe exp_kind + = traceTc "tcHsType tuple" (ppr hs_tys) >> + tc_tuple rn_ty mode tup_sort hs_tys exp_kind + | otherwise + = do { traceTc "tcHsType tuple 2" (ppr hs_tys) + ; (tys, kinds) <- mapAndUnzipM (tc_infer_lhs_type mode) hs_tys + ; kinds <- liftZonkM $ mapM zonkTcType kinds + -- Infer each arg type separately, because errors can be + -- confusing if we give them a shared kind. Eg #7410 + -- (Either Int, Int), we do not want to get an error saying + -- "the second argument of a tuple should have kind *->*" + + ; let (arg_kind, tup_sort) + = case [ (k,s) | k <- kinds + , Just s <- [tupKindSort_maybe k] ] of + ((k,s) : _) -> (k,s) + [] -> (liftedTypeKind, BoxedTuple) + -- In the [] case, it's not clear what the kind is, so guess * ---------- Potentially kind-polymorphic types: call the "up" checker --- See Note [Future-proofing the type checker] -tc_hs_type mode ty@(HsTyVar {}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(HsAppTy {}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(HsAppKindTy{}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(HsOpTy {}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(HsKindSig {}) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type mode ty@(XHsType {}) ek = tc_infer_hs_type_ek mode ty ek + ; tys' <- sequence [ setSrcSpanA loc $ + checkExpectedKind hs_ty ty kind arg_kind + | ((L loc hs_ty),ty,kind) <- zip3 hs_tys tys kinds ] + + ; finish_tuple rn_ty tup_sort tys' (map (const arg_kind) tys') exp_kind } +tc_hs_tuple_ty rn_ty mode HsUnboxedTuple tys exp_kind = + tc_tuple rn_ty mode UnboxedTuple tys exp_kind {- +Note [Kind-checking explicit lists] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In a type, suppose we have an application (F [t1,t2]), +where [t1,t2] is an explicit list, and + F :: [ki] -> blah + +Then we want to return the type + F ((:) @ki t2 ((:) @ki t2 ([] @ki))) +where the argument list is instantiated to F's argument kind `ki`. + +But what about (G []), where + G :: (forall k. [k]) -> blah + +Here we want to return (G []), with no instantiation at all. But since we have +no lambda in types, we must be careful not to instantiate that `[]`, because we +can't re-generalise it. Hence, when kind-checking an explicit list, we need a +special case for `[]`. + Note [Variable Specificity and Forall Visibility] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A HsForAllTy contains an HsForAllTelescope to denote the visibility of the forall @@ -1366,28 +1342,28 @@ Note [VarBndrs, ForAllTyBinders, TyConBinders, and visibility] in "GHC.Core.TyCo ------------------------------------------ tc_mult :: TcTyMode -> HsArrow GhcRn -> TcM Mult -tc_mult mode ty = tc_lhs_type mode (arrowToHsType ty) multiplicityTy +tc_mult mode ty = tc_check_lhs_type mode (arrowToHsType ty) multiplicityTy ------------------------------------------ -tc_fun_type :: TcTyMode -> HsArrow GhcRn -> LHsType GhcRn -> LHsType GhcRn -> TcKind +tc_fun_type :: TcTyMode -> HsArrow GhcRn -> LHsType GhcRn -> LHsType GhcRn -> ExpKind -> TcM TcType tc_fun_type mode mult ty1 ty2 exp_kind = case mode_tyki mode of TypeLevel -> do { traceTc "tc_fun_type" (ppr ty1 $$ ppr ty2) ; arg_k <- newOpenTypeKind ; res_k <- newOpenTypeKind - ; ty1' <- tc_lhs_type mode ty1 arg_k - ; ty2' <- tc_lhs_type mode ty2 res_k + ; ty1' <- tc_check_lhs_type mode ty1 arg_k + ; ty2' <- tc_check_lhs_type mode ty2 res_k ; mult' <- tc_mult mode mult - ; checkExpectedKind (HsFunTy noExtField mult ty1 ty2) - (tcMkVisFunTy mult' ty1' ty2') - liftedTypeKind exp_kind } + ; checkExpKind (HsFunTy noExtField mult ty1 ty2) + (tcMkVisFunTy mult' ty1' ty2') + liftedTypeKind exp_kind } KindLevel -> -- no representation polymorphism in kinds. yet. - do { ty1' <- tc_lhs_type mode ty1 liftedTypeKind - ; ty2' <- tc_lhs_type mode ty2 liftedTypeKind + do { ty1' <- tc_check_lhs_type mode ty1 liftedTypeKind + ; ty2' <- tc_check_lhs_type mode ty2 liftedTypeKind ; mult' <- tc_mult mode mult - ; checkExpectedKind (HsFunTy noExtField mult ty1 ty2) - (tcMkVisFunTy mult' ty1' ty2') - liftedTypeKind exp_kind } + ; checkExpKind (HsFunTy noExtField mult ty1 ty2) + (tcMkVisFunTy mult' ty1' ty2') + liftedTypeKind exp_kind } {- Note [Skolem escape and forall-types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1442,7 +1418,7 @@ tc_tuple rn_ty mode tup_sort tys exp_kind BoxedTuple -> return (replicate arity liftedTypeKind) UnboxedTuple -> replicateM arity newOpenTypeKind ConstraintTuple -> return (replicate arity constraintKind) - ; tau_tys <- zipWithM (tc_lhs_type mode) tys arg_kinds + ; tau_tys <- zipWithM (tc_check_lhs_type mode) tys arg_kinds ; finish_tuple rn_ty tup_sort tau_tys arg_kinds exp_kind } where arity = length tys @@ -1530,9 +1506,9 @@ since the two constraints should be semantically equivalent. * * ********************************************************************* -} -splitHsAppTys :: HsType GhcRn -> Maybe (LHsType GhcRn, [LHsTypeArg GhcRn]) -splitHsAppTys hs_ty - | is_app hs_ty = Just (go (noLocA hs_ty) []) +splitHsAppTys_maybe :: HsType GhcRn -> Maybe (LHsType GhcRn, [LHsTypeArg GhcRn]) +splitHsAppTys_maybe hs_ty + | is_app hs_ty = Just (splitHsAppTys hs_ty) | otherwise = Nothing where is_app :: HsType GhcRn -> Bool @@ -1547,6 +1523,10 @@ splitHsAppTys hs_ty is_app (HsParTy _ (L _ ty)) = is_app ty is_app _ = False +splitHsAppTys :: HsType GhcRn -> (LHsType GhcRn, [LHsTypeArg GhcRn]) + +splitHsAppTys hs_ty = go (noLocA hs_ty) [] + where go :: LHsType GhcRn -> [HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)] -> (LHsType GhcRn, @@ -1570,6 +1550,14 @@ tcInferTyAppHead _ (L _ (HsTyVar _ _ (L _ tv))) tcInferTyAppHead mode ty = tc_infer_lhs_type mode ty +tc_app_ty :: TcTyMode -> HsType GhcRn -> ExpKind -> TcM TcType +tc_app_ty mode rn_ty exp_kind + = do { (fun_ty, _ki) <- tcInferTyAppHead mode hs_fun_ty + ; (ty, infered_kind) <- tcInferTyApps mode hs_fun_ty fun_ty hs_args + ; checkExpKind rn_ty ty infered_kind exp_kind } + where + (hs_fun_ty, hs_args) = splitHsAppTys rn_ty + --------------------------- -- | Apply a type of a given kind to a list of arguments. This instantiates -- invisible parameters as necessary. Always consumes all the arguments, @@ -1656,7 +1644,7 @@ tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args ; arg_mode <- mkHoleMode KindLevel HM_VTA -- HM_VKA: see Note [Wildcards in visible kind application] ; ki_arg <- addErrCtxt (funAppCtxt orig_hs_ty hs_ki_arg n) $ - tc_lhs_type arg_mode hs_ki_arg exp_kind + tc_check_lhs_type arg_mode hs_ki_arg exp_kind ; traceTc "tcInferTyApps (vis kind app)" (ppr exp_kind) ; (subst', fun') <- mkAppTyM subst fun ki_binder ki_arg @@ -1687,7 +1675,7 @@ tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args , ppr subst ]) ; let exp_kind = substTy subst $ piTyBinderType ki_binder ; arg' <- addErrCtxt (funAppCtxt orig_hs_ty arg n) $ - tc_lhs_type mode arg exp_kind + tc_check_lhs_type mode arg exp_kind ; traceTc "tcInferTyApps (vis normal app) 2" (ppr exp_kind) ; (subst', fun') <- mkAppTyM subst fun ki_binder arg' ; go (n+1) fun' subst' inner_ki args } @@ -1975,6 +1963,19 @@ checkExpectedKind hs_ty ty act_kind exp_kind n_act_invis_bndrs = invisibleTyBndrCount act_kind n_to_inst = n_act_invis_bndrs - n_exp_invis_bndrs + +-- tyr <- checkExpKind hs_ty ty (act_ki :: Kind) (exp_ki :: ExpKind) +-- requires that `ty` has kind `act_ki` +-- It checks that the actual kind `act_ki` matches the expected kind `exp_ki` +-- and returns `tyr`, a possibly-casted form of `ty`, that has precisely kind `exp_ki` +-- `hs_ty` is purely for error messages +checkExpKind :: HsType GhcRn -> TcType -> TcKind -> ExpKind -> TcM TcType +checkExpKind rn_ty ty ki (Check ki') = + checkExpectedKind rn_ty ty ki ki' +checkExpKind _rn_ty ty ki (Infer cell) = do + co <- fillInferResult ki cell + pure (ty `mkCastTy` co) + --------------------------- tcHsContext :: Maybe (LHsContext GhcRn) -> TcM [PredType] @@ -1988,7 +1989,7 @@ tc_hs_context :: TcTyMode -> LHsContext GhcRn -> TcM [PredType] tc_hs_context mode ctxt = mapM (tc_lhs_pred mode) (unLoc ctxt) tc_lhs_pred :: TcTyMode -> LHsType GhcRn -> TcM PredType -tc_lhs_pred mode pred = tc_lhs_type mode pred constraintKind +tc_lhs_pred mode pred = tc_check_lhs_type mode pred constraintKind --------------------------- tcTyVar :: Name -> TcM (TcType, TcKind) @@ -4109,7 +4110,7 @@ tcHsPartialSigType ctxt sig_ty ; tau <- -- Don't do (addTypeCtxt hs_tau) here else we get -- In the type -- In the type signature: foo :: - tc_lhs_type mode hs_tau ek + tc_check_lhs_type mode hs_tau ek ; return (wcs, wcx, theta, tau) } @@ -4419,8 +4420,8 @@ tc_type_in_pat ctxt hole_mode hs_ty wcs ns ctxt_kind -- and c.f #16033 bindNamedWildCardBinders wcs $ \ wcs -> tcExtendNameTyVarEnv tkv_prs $ - do { ek <- newExpectedKind ctxt_kind - ; ty <- tc_lhs_type mode hs_ty ek + do { ek <- newExpectedKind ctxt_kind + ; ty <- tc_check_lhs_type mode hs_ty ek ; return (wcs, ty) } ; mapM_ emitNamedTypeHole wcs @@ -4596,7 +4597,7 @@ tc_lhs_kind_sig mode ctxt hs_kind -- Result is zonked = do { kind <- addErrCtxt (text "In the kind" <+> quotes (ppr hs_kind)) $ solveEqualities "tcLHsKindSig" $ - tc_lhs_type mode hs_kind liftedTypeKind + tc_check_lhs_type mode hs_kind liftedTypeKind ; traceTc "tcLHsKindSig" (ppr hs_kind $$ ppr kind) -- No generalization: ; kindGeneralizeNone kind ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -1772,7 +1772,7 @@ kcTyClDecl (DataDecl { tcdLName = (L _ _name), tcdDataDefn = HsDataDefn { dd_ kcTyClDecl (SynDecl { tcdLName = L _ _name, tcdRhs = rhs }) tycon = tcExtendNameTyVarEnv (tcTyConScopedTyVars tycon) $ let res_kind = tyConResKind tycon - in discardResult $ tcCheckLHsType rhs (TheKind res_kind) + in discardResult $ tcCheckLHsTypeInContext rhs (TheKind res_kind) -- NB: check against the result kind that we allocated -- in inferInitialKinds. @@ -1801,7 +1801,7 @@ kcTyClDecl (FamDecl _ (FamilyDecl { fdInfo = fd_info })) fam_tc kcConArgTys :: NewOrData -> TcKind -> [HsScaled GhcRn (LHsType GhcRn)] -> TcM () kcConArgTys new_or_data res_kind arg_tys = do { let exp_kind = getArgExpKind new_or_data res_kind - ; forM_ arg_tys (\(HsScaled mult ty) -> do _ <- tcCheckLHsType (getBangType ty) exp_kind + ; forM_ arg_tys (\(HsScaled mult ty) -> do _ <- tcCheckLHsTypeInContext (getBangType ty) exp_kind tcMult mult) -- See Note [Implementation of UnliftedNewtypes], STEP 2 } @@ -1868,7 +1868,7 @@ kcConDecl new_or_data do { _ <- tcHsContext cxt ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty) ; con_res_kind <- newOpenTypeKind - ; _ <- tcCheckLHsType res_ty (TheKind con_res_kind) + ; _ <- tcCheckLHsTypeInContext res_ty (TheKind con_res_kind) ; kcConGADTArgs new_or_data con_res_kind args ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr con_res_kind) ; return () } @@ -1895,7 +1895,7 @@ Otherwise we'd infer the bogus kind The type signature for MkT influences the kind of T simply by kind-checking the result type (T g b), which will force 'f' and 'g' to have the same kinds. This is the call to - tcCheckLHsType res_ty (TheKind con_res_kind) + tcCheckLHsTypeInContext res_ty (TheKind con_res_kind) Because this is the result type of an arrow, we know the kind must be of form (TYPE rr), and we get better error messages if we enforce that here (e.g. test gadt10). @@ -3054,7 +3054,7 @@ tcTySynRhs roles_info tc_name hs_ty do { env <- getLclEnv ; traceTc "tc-syn" (ppr tc_name $$ ppr (getLclEnvRdrEnv env)) ; rhs_ty <- pushLevelAndSolveEqualities skol_info tc_bndrs $ - tcCheckLHsType hs_ty (TheKind res_kind) + tcCheckLHsTypeInContext hs_ty (TheKind res_kind) -- See Note [Error on unconstrained meta-variables] in GHC.Tc.Utils.TcMType -- Example: (typecheck/should_fail/T17567) @@ -3197,7 +3197,7 @@ kcTyFamInstEqn tc_fam_tc ; discardResult $ bindOuterFamEqnTKBndrs_Q_Tv outer_bndrs $ do { (_fam_app, res_kind) <- tcFamTyPats tc_fam_tc hs_pats - ; tcCheckLHsType hs_rhs_ty (TheKind res_kind) } + ; tcCheckLHsTypeInContext hs_rhs_ty (TheKind res_kind) } -- Why "_Tv" here? Consider (#14066) -- type family Bar x y where -- Bar (x :: a) (y :: b) = Int @@ -3349,7 +3349,7 @@ tcTyFamInstEqnGuts fam_tc mb_clsinfo outer_hs_bndrs hs_pats hs_rhs_ty -- Ensure that the instance is consistent with its -- parent class (#16008) ; addConsistencyConstraints mb_clsinfo lhs_ty - ; rhs_ty <- tcCheckLHsType hs_rhs_ty (TheKind rhs_kind) + ; rhs_ty <- tcCheckLHsTypeInContext hs_rhs_ty (TheKind rhs_kind) ; return (lhs_ty, rhs_ty) } ; outer_bndrs <- scopedSortOuter outer_bndrs @@ -3926,7 +3926,7 @@ tcConArg :: ContextKind -- expected kind for args; always OpenKind for datatype -> HsScaled GhcRn (LHsType GhcRn) -> TcM (Scaled TcType, HsSrcBang) tcConArg exp_kind (HsScaled w bty) = do { traceTc "tcConArg 1" (ppr bty) - ; arg_ty <- tcCheckLHsType (getBangType bty) exp_kind + ; arg_ty <- tcCheckLHsTypeInContext (getBangType bty) exp_kind ; w' <- tcDataConMult w ; traceTc "tcConArg 2" (ppr bty) ; return (Scaled w' arg_ty, getBangStrictness bty) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Tc.Utils.TcType ( TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcInvisTVBinder, TcReqTVBinder, TcTyCon, MonoTcTyCon, PolyTcTyCon, TcTyConBinder, KnotTied, - ExpType(..), InferResult(..), + ExpType(..), ExpKind, InferResult(..), ExpTypeFRR, ExpSigmaType, ExpSigmaTypeFRR, ExpRhoType, mkCheckExpType, @@ -433,6 +433,9 @@ type ExpSigmaTypeFRR = ExpTypeFRR type ExpRhoType = ExpType +-- | Like 'ExpType', but on kind level +type ExpKind = ExpType + instance Outputable ExpType where ppr (Check ty) = text "Check" <> braces (ppr ty) ppr (Infer ir) = ppr ir ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -43,6 +43,8 @@ module GHC.Tc.Utils.Unify ( PuResult(..), failCheckWith, okCheckRefl, mapCheck, TyEqFlags(..), TyEqFamApp(..), AreUnifying(..), LevelCheck(..), FamAppBreaker, famAppArgFlags, simpleUnifyCheck, checkPromoteFreeVars, + + fillInferResult, ) where import GHC.Prelude ===================================== compiler/Language/Haskell/Syntax/Type.hs ===================================== @@ -1006,7 +1006,7 @@ would mean that when we pretty-print it back, we don't know whether the user wrote '*' or 'Type', and lose the parse/ppr roundtrip property. As a workaround, we parse '*' as HsStarTy (if it stands for 'Data.Kind.Type') -and then desugar it to 'Data.Kind.Type' in the typechecker (see tc_hs_type). +and then desugar it to 'Data.Kind.Type' in the typechecker (see tcHsType). When '*' is a regular type operator (StarIsType is disabled), HsStarTy is not involved. ===================================== testsuite/tests/partial-sigs/should_run/GHCiWildcardKind.stdout ===================================== @@ -1,2 +1,2 @@ -_ :: k +_ :: p Maybe _ :: * ===================================== testsuite/tests/th/T24299.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T24299 where +import Language.Haskell.TH.Syntax (addModFinalizer, runIO) +import GHC.Types (Type) +import System.IO + +type Proxy :: forall a. a -> Type +data Proxy a = MkProxy + +check :: ($(addModFinalizer (runIO (do putStrLn "check"; hFlush stdout)) >> + [t| Proxy |]) :: Type -> Type) Int -- There is kind signature, we are in check mode +check = MkProxy + +infer :: ($(addModFinalizer (runIO (do putStrLn "infer"; hFlush stdout)) >> + [t| Proxy |]) ) Int -- no kind signature, inference mode is enabled +infer = MkProxy ===================================== testsuite/tests/th/T24299.stderr ===================================== @@ -0,0 +1,2 @@ +check +infer ===================================== testsuite/tests/th/all.T ===================================== @@ -606,3 +606,4 @@ test('T14032e', normal, compile_fail, ['-dsuppress-uniques']) test('ListTuplePunsTH', [only_ways(['ghci']), extra_files(['ListTuplePunsTH.hs', 'T15843a.hs'])], ghci_script, ['ListTuplePunsTH.script']) test('T24559', normal, compile, ['']) test('T24571', normal, compile, ['']) +test('T24299', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1c18c7b70f25a733fe36a24950a981134751767 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1c18c7b70f25a733fe36a24950a981134751767 You're receiving 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 Apr 2 17:22:41 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 02 Apr 2024 13:22:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 45 commits: rts: Fix TSAN_ENABLED CPP guard Message-ID: <660c3ee17067d_f9da121db84392c8@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - dda18f97 by Duncan Coutts at 2024-04-02T13:22:18-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - f6405b9f by Duncan Coutts at 2024-04-02T13:22:18-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. This change is also reflected in the RTS flags types in the base library. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. - - - - - ec863cb3 by Duncan Coutts at 2024-04-02T13:22:18-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - 75ba245f by Duncan Coutts at 2024-04-02T13:22:18-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - b0d3b19f by Duncan Coutts at 2024-04-02T13:22:18-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - b7649169 by Duncan Coutts at 2024-04-02T13:22:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - a18cb695 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. - - - - - 155602b5 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Use atomic operations to update tso->why_blocked in the C code In the primops ported from Cmm to C. Since patch 515eb33d4fc the why_blocked gets accessed using load acquire and store release atomics. There was one exception to this new rule in 515eb33d4fc: for the delay# primop on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. I'm playing it safe here and using store release consistently. - - - - - 88a3b93c by Duncan Coutts at 2024-04-02T13:22:19-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 136edfdb by Duncan Coutts at 2024-04-02T13:22:19-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - 2433bc3f by Duncan Coutts at 2024-04-02T13:22:19-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - f194aaec by Duncan Coutts at 2024-04-02T13:22:19-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. - - - - - f0545200 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - df660784 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - b402e158 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d694b0fa by Duncan Coutts at 2024-04-02T13:22:19-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - ef60a964 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 14f7ed5c by Duncan Coutts at 2024-04-02T13:22:19-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - c9861100 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - 57abc5d3 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - e891bb2e by Duncan Coutts at 2024-04-02T13:22:19-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - a1905d4d by Duncan Coutts at 2024-04-02T13:22:19-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 13734227 by Duncan Coutts at 2024-04-02T13:22:19-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 1fc6ee4c by Duncan Coutts at 2024-04-02T13:22:19-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 2ac87360 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - b14bb8a2 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - 4922cb30 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Review feedback: simplify ./configure support for I/O managers Have all decisions be automatic without any user influence, rather than automatic with user-specified flags to override. This entails removing the existing --enable-native-io-manager flag. Also simplify the CPP flags defined by ./configure and have more stuff done by IOManager.h instead. This also gives us a place to put sanity checks for there being a default I/O manager. - - - - - 33350cbe by Duncan Coutts at 2024-04-02T13:22:19-04:00 Fixup: make showIOManager public (non-static) declare it in IOManager.h - - - - - 75507feb by Duncan Coutts at 2024-04-02T13:22:19-04:00 Include the default I/O manager in the +RTS --info output - - - - - b5fcc525 by Duncan Coutts at 2024-04-02T13:22:19-04:00 fixup: fix spelling in src/GHC/Internal/IO/SubSystem.hs - - - - - f936ecba by Duncan Coutts at 2024-04-02T13:22:19-04:00 fixup: fix spelling in rts/IOManager.h - - - - - 5b29b688 by Duncan Coutts at 2024-04-02T13:22:19-04:00 review feedback: document the post-condition of awaitCompletedTimeoutsOrIO - - - - - 1f7a18e3 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Document --io-manager flag in the user guide And the -Do debug flag. - - - - - c3cdce8a by Duncan Coutts at 2024-04-02T13:22:19-04:00 Use "unrecognised" rather than "unknown" for io-manager flag parsing Somewhat clearer meaning in the code and error messages. - - - - - 79bfa225 by Duncan Coutts at 2024-04-02T13:22:19-04:00 Re-export IoSubSystem from GHC.RTS.Flags with deprecation warning It was exported here previously. Reinstate the export for ease of migration, now with a deprecation warning for where to get it from instead. See https://github.com/haskell/core-libraries-committee/issues/263 - - - - - 8547e0a0 by Duncan Coutts at 2024-04-02T13:22:19-04:00 FIXUP: base-exports - - - - - 27d1a25b by Rodrigo Mesquita at 2024-04-02T13:22:20-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - 1f26c63b by Sylvain Henry at 2024-04-02T13:22:32-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 2e84acd9 by Sylvain Henry at 2024-04-02T13:22:32-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - 30 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/Language/Haskell/Syntax/Type.hs - docs/users_guide/runtime_control.rst - libraries/base/src/GHC/IO/SubSystem.hs - libraries/base/src/GHC/RTS/Flags.hs - libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs - + m4/ghc_iomanagers.m4 - rts/Capability.c - rts/Capability.h - rts/IOManager.c - rts/IOManager.h - + rts/IOManagerInternals.h - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsFlags.c - rts/RtsFlags.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c1c37c47130f1f78137f49a1bfb5e0e3dd322b37...2e84acd912d4db77a25cb68f434de8f41d30b455 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c1c37c47130f1f78137f49a1bfb5e0e3dd322b37...2e84acd912d4db77a25cb68f434de8f41d30b455 You're receiving 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 Apr 2 19:53:14 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 02 Apr 2024 15:53:14 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Message-ID: <660c622a2c0de_f9da2688790693ae@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9e0e56ef by Rodrigo Mesquita at 2024-04-02T15:52:53-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - 088d7cca by Sylvain Henry at 2024-04-02T15:52:56-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - beccd51a by Sylvain Henry at 2024-04-02T15:52:56-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - 1e9737cd by Simon Peyton Jones at 2024-04-02T15:52:57-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - 3dffa742 by Simon Peyton Jones at 2024-04-02T15:52:57-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 26 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/Tc/Gen/HsType.hs - libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs - rts/js/string.js - + testsuite/tests/javascript/Makefile - + testsuite/tests/javascript/T24495.hs - + testsuite/tests/javascript/T24495.stdout - testsuite/tests/javascript/all.T - testsuite/tests/saks/should_compile/saks018.hs - testsuite/tests/saks/should_compile/saks021.hs - testsuite/tests/saks/should_fail/all.T - + testsuite/tests/saks/should_fail/saks018-fail.hs - + testsuite/tests/saks/should_fail/saks018-fail.stderr - + testsuite/tests/saks/should_fail/saks021-fail.hs - + testsuite/tests/saks/should_fail/saks021-fail.stderr - testsuite/tests/typecheck/should_compile/T24470b.hs - + testsuite/tests/vdq-rta/should_fail/T24604.hs - + testsuite/tests/vdq-rta/should_fail/T24604.stderr - + testsuite/tests/vdq-rta/should_fail/T24604a.hs - + testsuite/tests/vdq-rta/should_fail/T24604a.stderr - testsuite/tests/vdq-rta/should_fail/all.T Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3023,7 +3023,7 @@ pushCoercionIntoLambda in_scope x e co | otherwise = Nothing -pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion +pushCoDataCon :: DataCon -> [CoreExpr] -> MCoercion -> Maybe (DataCon , [Type] -- Universal type args , [CoreExpr]) -- All other args incl existentials @@ -3033,10 +3033,20 @@ pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion -- where co :: (T t1 .. tn) ~ to_ty -- The left-hand one must be a T, because exprIsConApp returned True -- but the right-hand one might not be. (Though it usually will.) -pushCoDataCon dc dc_args co - | isReflCo co || from_ty `eqType` to_ty -- try cheap test first - , let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args - = Just (dc, map exprToType univ_ty_args, rest_args) +pushCoDataCon dc dc_args MRefl = Just $! (push_dc_refl dc dc_args) +pushCoDataCon dc dc_args (MCo co) = push_dc_gen dc dc_args co (coercionKind co) + +push_dc_refl :: DataCon -> [CoreExpr] -> (DataCon, [Type], [CoreExpr]) +push_dc_refl dc dc_args + = (dc, map exprToType univ_ty_args, rest_args) + where + !(univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args + +push_dc_gen :: DataCon -> [CoreExpr] -> Coercion -> Pair Type + -> Maybe (DataCon, [Type], [CoreExpr]) +push_dc_gen dc dc_args co (Pair from_ty to_ty) + | from_ty `eqType` to_ty -- try cheap test first + = Just $! (push_dc_refl dc dc_args) | Just (to_tc, to_tc_arg_tys) <- splitTyConApp_maybe to_ty , to_tc == dataConTyCon dc @@ -3082,8 +3092,6 @@ pushCoDataCon dc dc_args co | otherwise = Nothing - where - Pair from_ty to_ty = coercionKind co collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr) -- Collect lambda binders, pushing coercions inside if possible ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -1211,7 +1211,7 @@ data-con wrappers, and that cure would be worse than the disease. This Note exists solely to document the problem. -} -data ConCont = CC [CoreExpr] Coercion +data ConCont = CC [CoreExpr] MCoercion -- Substitution already applied -- | Returns @Just ([b1..bp], dc, [t1..tk], [x1..xn])@ if the argument @@ -1233,7 +1233,7 @@ exprIsConApp_maybe :: HasDebugCallStack => InScopeEnv -> CoreExpr -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr]) exprIsConApp_maybe ise@(ISE in_scope id_unf) expr - = go (Left in_scope) [] expr (CC [] (mkRepReflCo (exprType expr))) + = go (Left in_scope) [] expr (CC [] MRefl) where go :: Either InScopeSet Subst -- Left in-scope means "empty substitution" @@ -1246,14 +1246,12 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr go subst floats (Tick t expr) cont | not (tickishIsCode t) = go subst floats expr cont - go subst floats (Cast expr co1) (CC args co2) + go subst floats (Cast expr co1) (CC args m_co2) | Just (args', m_co1') <- pushCoArgs (subst_co subst co1) args -- See Note [Push coercions in exprIsConApp_maybe] - = case m_co1' of - MCo co1' -> go subst floats expr (CC args' (co1' `mkTransCo` co2)) - MRefl -> go subst floats expr (CC args' co2) + = go subst floats expr (CC args' (m_co1' `mkTransMCo` m_co2)) - go subst floats (App fun arg) (CC args co) + go subst floats (App fun arg) (CC args mco) | let arg_type = exprType arg , not (isTypeArg arg) && needsCaseBinding arg_type arg -- An unlifted argument that’s not ok for speculation must not simply be @@ -1276,17 +1274,17 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr bndr = uniqAway (subst_in_scope subst) (mkWildValBinder ManyTy arg_type) float = FloatCase arg' bndr DEFAULT [] subst' = subst_extend_in_scope subst bndr - in go subst' (float:floats) fun (CC (Var bndr : args) co) + in go subst' (float:floats) fun (CC (Var bndr : args) mco) | otherwise - = go subst floats fun (CC (subst_expr subst arg : args) co) + = go subst floats fun (CC (subst_expr subst arg : args) mco) - go subst floats (Lam bndr body) (CC (arg:args) co) + go subst floats (Lam bndr body) (CC (arg:args) mco) | do_beta_by_substitution bndr arg - = go (extend subst bndr arg) floats body (CC args co) + = go (extend subst bndr arg) floats body (CC args mco) | otherwise = let (subst', bndr') = subst_bndr subst bndr float = FloatLet (NonRec bndr' arg) - in go subst' (float:floats) body (CC args co) + in go subst' (float:floats) body (CC args mco) go subst floats (Let (NonRec bndr rhs) expr) cont | not (isJoinId bndr) @@ -1311,12 +1309,12 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr (lookupIdSubst sub v) cont - go (Left in_scope) floats (Var fun) cont@(CC args co) + go (Left in_scope) floats (Var fun) cont@(CC args mco) | Just con <- isDataConWorkId_maybe fun , count isValArg args == idArity fun = succeedWith in_scope floats $ - pushCoDataCon con args co + pushCoDataCon con args mco -- Look through data constructor wrappers: they inline late (See Note -- [Activation for data constructor wrappers]) but we want to do @@ -1336,7 +1334,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- simplOptExpr initialises the in-scope set with exprFreeVars, -- but that doesn't account for DFun unfoldings = succeedWith in_scope floats $ - pushCoDataCon con (map (substExpr subst) dfun_args) co + pushCoDataCon con (map (substExpr subst) dfun_args) mco -- Look through unfoldings, but only arity-zero one; -- if arity > 0 we are effectively inlining a function call, @@ -1354,7 +1352,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr , [arg] <- args , Just (LitString str) <- exprIsLiteral_maybe ise arg = succeedWith in_scope floats $ - dealWithStringLiteral fun str co + dealWithStringLiteral fun str mco where unfolding = id_unf fun extend_in_scope unf_fvs @@ -1404,15 +1402,15 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- See Note [exprIsConApp_maybe on literal strings] -dealWithStringLiteral :: Var -> BS.ByteString -> Coercion +dealWithStringLiteral :: Var -> BS.ByteString -> MCoercion -> Maybe (DataCon, [Type], [CoreExpr]) -- This is not possible with user-supplied empty literals, GHC.Core.Make.mkStringExprFS -- turns those into [] automatically, but just in case something else in GHC -- generates a string literal directly. -dealWithStringLiteral fun str co = +dealWithStringLiteral fun str mco = case utf8UnconsByteString str of - Nothing -> pushCoDataCon nilDataCon [Type charTy] co + Nothing -> pushCoDataCon nilDataCon [Type charTy] mco Just (char, charTail) -> let char_expr = mkConApp charDataCon [mkCharLit char] -- In singleton strings, just add [] instead of unpackCstring# ""#. @@ -1421,7 +1419,7 @@ dealWithStringLiteral fun str co = else App (Var fun) (Lit (LitString charTail)) - in pushCoDataCon consDataCon [Type charTy, char_expr, rest] co + in pushCoDataCon consDataCon [Type charTy, char_expr, rest] mco {- Note [Unfolding DFuns] ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -46,7 +46,6 @@ import GHC.StgToJS.Rts.Types import GHC.StgToJS.Stack import GHC.StgToJS.Ids -import GHC.Types.Literal import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.CostCentre @@ -60,7 +59,6 @@ import GHC.Core.TyCon import GHC.Core.DataCon import GHC.Core.Type hiding (typeSize) -import GHC.Utils.Encoding import GHC.Utils.Misc import GHC.Utils.Monad import GHC.Utils.Panic @@ -100,22 +98,6 @@ genApp -> G (JStgStat, ExprResult) genApp ctx i args - -- Case: unpackCStringAppend# "some string"# str - -- - -- Generates h$appendToHsStringA(str, "some string"), which has a faster - -- decoding loop. - | [StgLitArg (LitString bs), x] <- args - , [top] <- concatMap typex_expr (ctxTarget ctx) - , getUnique i == unpackCStringAppendIdKey - , d <- utf8DecodeByteString bs - = do - prof <- csProf <$> getSettings - let profArg = if prof then [jCafCCS] else [] - a <- genArg x - return ( top |= app "h$appendToHsStringA" (toJExpr d : a ++ profArg) - , ExprInline - ) - -- let-no-escape | Just n <- ctxLneBindingStackSize ctx i = do ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -60,11 +60,13 @@ import GHC.Types.Var.Set import GHC.Types.Id import GHC.Types.Unique.FM import GHC.Types.RepType +import GHC.Types.Literal import GHC.Stg.Syntax import GHC.Stg.Utils import GHC.Builtin.PrimOps +import GHC.Builtin.Names import GHC.Core hiding (Var) import GHC.Core.TyCon @@ -73,6 +75,7 @@ import GHC.Core.Opt.Arity (isOneShotBndr) import GHC.Core.Type hiding (typeSize) import GHC.Utils.Misc +import GHC.Utils.Encoding import GHC.Utils.Monad import GHC.Utils.Panic import GHC.Utils.Outputable (ppr, renderWithContext, defaultSDocContext) @@ -555,6 +558,36 @@ genCase :: HasDebugCallStack -> LiveVars -> G (JStgStat, ExprResult) genCase ctx bnd e at alts l + -- For: unpackCStringAppend# "some string"# str + -- Generate: h$appendToHsStringA(str, "some string") + -- + -- The latter has a faster decoding loop. + -- + -- Since #23270 and 7e0c8b3bab30, literals strings aren't STG atoms and we + -- need to match the following instead: + -- + -- case "some string"# of b { + -- DEFAULT -> unpackCStringAppend# b str + -- } + -- + -- Wrinkle: it doesn't kick in when literals are floated out to the top level. + -- + | StgLit (LitString bs) <- e + , [GenStgAlt DEFAULT _ rhs] <- alts + , StgApp i args <- rhs + , getUnique i == unpackCStringAppendIdKey + , [StgVarArg b',x] <- args + , bnd == b' + , d <- utf8DecodeByteString bs + , [top] <- concatMap typex_expr (ctxTarget ctx) + = do + prof <- csProf <$> getSettings + let profArg = if prof then [jCafCCS] else [] + a <- genArg x + return ( top |= app "h$appendToHsStringA" (toJExpr d : a ++ profArg) + , ExprInline + ) + | isInlineExpr e = do bndi <- identsForId bnd let ctx' = ctxSetTop bnd ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -191,6 +191,9 @@ genCommonCppDefs profiling = mconcat -- resumable thunks , "#define MAKE_RESUMABLE(closure,stack) { (closure).f = h$resume_e; (closure).d1 = (stack), (closure).d2 = null; }\n" + -- making a thunk + , "#define MK_UPD_THUNK(closure) h$c1(h$upd_thunk_e,(closure))\n" + -- general deconstruction , "#define IS_THUNK(x) ((x).f.t === CLOSURE_TYPE_THUNK)\n" , "#define CONSTR_TAG(x) ((x).f.a)\n" ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -448,6 +448,19 @@ rts_gen s = do , r4 |= d4 , returnS (app "h$ap_3_3_fast" []) ]) + , closure (ClosureInfo (TxtI "h$upd_thunk_e") (CIRegs 0 [PtrV]) "updatable thunk" (CILayoutFixed 1 [PtrV]) CIThunk mempty) + (jVar $ \t -> return $ + mconcat [t |= closureField1 r1 + , adjSp' 2 + , stack .! (sp - 1) |= r1 + , stack .! sp |= var "h$upd_frame" + , closureEntry r1 |= var "h$blackhole" + , closureField1 r1 |= var "h$currentThread" + , closureField2 r1 |= null_ + , r1 |= t + , returnS (app "h$ap_0_0_fast" []) + ] + ) -- select first field , closure (ClosureInfo (global "h$select1_e") (CIRegs 0 [PtrV]) "select1" (CILayoutFixed 1 [PtrV]) CIThunk mempty) (jVar \t -> return $ ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2570,9 +2570,11 @@ kcCheckDeclHeader_sig sig_kind name flav ; traceTc "kcCheckDeclHeader_sig {" $ vcat [ text "sig_kind:" <+> ppr sig_kind , text "sig_tcbs:" <+> ppr sig_tcbs - , text "sig_res_kind:" <+> ppr sig_res_kind ] + , text "sig_res_kind:" <+> ppr sig_res_kind + , text "implict_nms:" <+> ppr implicit_nms + , text "hs_tv_bndrs:" <+> ppr hs_tv_bndrs ] - ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, (extra_tcbs, tycon_res_kind)))) + ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, skol_scoped_tvs, (extra_tcbs, tycon_res_kind)))) <- pushLevelAndSolveEqualitiesX "kcCheckDeclHeader_sig" $ -- #16687 bindImplicitTKBndrs_Q_Tv implicit_nms $ -- Q means don't clone matchUpSigWithDecl name sig_tcbs sig_res_kind hs_tv_bndrs $ \ excess_sig_tcbs sig_res_kind -> @@ -2615,9 +2617,18 @@ kcCheckDeclHeader_sig sig_kind name flav -- Here p and q both map to the same kind variable k. We don't allow this -- so we must check that they are distinct. A similar thing happens -- in GHC.Tc.TyCl.swizzleTcTyConBinders during inference. + -- + -- With visible dependent quantification, one of the binders involved + -- may be explicit. Consider #24604 + -- type UF :: forall zk -> zk -> Constraint + -- class UF kk (xb :: k) + -- Here `k` and `kk` both denote the same variable; but only `k` is implicit + -- Hence we need to add skol_scoped_tvs ; implicit_tvs <- liftZonkM $ zonkTcTyVarsToTcTyVars implicit_tvs ; let implicit_prs = implicit_nms `zip` implicit_tvs - ; checkForDuplicateScopedTyVars implicit_prs + dup_chk_prs = implicit_prs ++ mkTyVarNamePairs skol_scoped_tvs + ; unless (null implicit_nms) $ -- No need if no implicit tyvars + checkForDuplicateScopedTyVars dup_chk_prs ; checkForDisconnectedScopedTyVars name flav all_tcbs implicit_prs -- Swizzle the Names so that the TyCon uses the user-declared implicit names @@ -2686,6 +2697,7 @@ matchUpSigWithDecl -> ([TcTyConBinder] -> TcKind -> TcM a) -- All user-written binders are in scope -- Argument is excess TyConBinders and tail kind -> TcM ( [TcTyConBinder] -- Skolemised binders, with TcTyVars + , [TcTyVar] -- Skolem tyvars brought into lexical scope by this matching-up , a ) -- See Note [Matching a kind signature with a declaration] -- Invariant: Length of returned TyConBinders + length of excess TyConBinders @@ -2696,7 +2708,7 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside go subst tcbs [] = do { let (subst', tcbs') = substTyConBindersX subst tcbs ; res <- thing_inside tcbs' (substTy subst' sig_res_kind) - ; return ([], res) } + ; return ([], [], res) } go _ [] hs_bndrs = failWithTc (TcRnTooManyBinders sig_res_kind hs_bndrs) @@ -2712,17 +2724,22 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside -- that come from the type declaration, not the kind signature subst' = extendTCvSubstWithClone subst tv tv' ; tc_hs_bndr (unLoc hs_bndr) (tyVarKind tv') - ; (tcbs', res) <- tcExtendTyVarEnv [tv'] $ - go subst' tcbs' hs_bndrs' - ; return (Bndr tv' vis : tcbs', res) } + ; traceTc "musd1" (ppr tcb $$ ppr hs_bndr $$ ppr tv') + ; (tcbs', tvs, res) <- tcExtendTyVarEnv [tv'] $ + go subst' tcbs' hs_bndrs' + ; return (Bndr tv' vis : tcbs', tv':tvs, res) } + -- We do a tcExtendTyVarEnv [tv'], so we return tv' in + -- the list of lexically-scoped skolem type variables | skippable (binderFlag tcb) = -- Invisible TyConBinder, so do not consume one of the hs_bndrs do { let (subst', tcb') = substTyConBinderX subst tcb - ; (tcbs', res) <- go subst' tcbs' hs_bndrs + ; traceTc "musd2" (ppr tcb $$ ppr hs_bndr $$ ppr tcb') + ; (tcbs', tvs, res) <- go subst' tcbs' hs_bndrs -- NB: pass on hs_bndrs unchanged; we do not consume a -- HsTyVarBndr for an invisible TyConBinder - ; return (tcb' : tcbs', res) } + ; return (tcb' : tcbs', tvs, res) } + -- Return `tvs`; no new lexically-scoped TyVars brought into scope | otherwise = -- At this point we conclude that: @@ -2736,14 +2753,19 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside = return () tc_hs_bndr (KindedTyVar _ _ (L _ hs_nm) lhs_kind) expected_kind = do { sig_kind <- tcLHsKindSig (TyVarBndrKindCtxt hs_nm) lhs_kind + ; traceTc "musd3:unifying" (ppr sig_kind $$ ppr expected_kind) ; discardResult $ -- See Note [discardResult in kcCheckDeclHeader_sig] unifyKind (Just (NameThing hs_nm)) sig_kind expected_kind } -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. + -- In particular: we match up if + -- (a) HsBndr looks like @k, and TyCon binder is forall k. (NamedTCB Specified) + -- (b) HsBndr looks like a, and TyCon binder is forall k -> (NamedTCB Required) + -- or k -> (AnonTCB) zippable :: TyConBndrVis -> HsBndrVis GhcRn -> Bool - zippable vis (HsBndrRequired _) = isVisibleTcbVis vis - zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis + zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis -- (a) + zippable vis (HsBndrRequired _) = isVisibleTcbVis vis -- (b) -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. @@ -3007,15 +3029,7 @@ checkForDisconnectedScopedTyVars name flav all_tcbs scoped_prs checkForDuplicateScopedTyVars :: [(Name,TcTyVar)] -> TcM () -- Check for duplicates --- E.g. data SameKind (a::k) (b::k) --- data T (a::k1) (b::k2) c = MkT (SameKind a b) c --- Here k1 and k2 start as TyVarTvs, and get unified with each other --- If this happens, things get very confused later, so fail fast --- --- In the CUSK case k1 and k2 are skolems so they won't unify; --- but in the inference case (see generaliseTcTyCon), --- and the type-sig case (see kcCheckDeclHeader_sig), they are --- TcTyVars, so we must check. +-- See Note [Aliasing in type and class declarations] checkForDuplicateScopedTyVars scoped_prs = unless (null err_prs) $ do { mapM_ report_dup err_prs; failM } @@ -3035,8 +3049,43 @@ checkForDuplicateScopedTyVars scoped_prs addErrTc $ TcRnDifferentNamesForTyVar n1 n2 -{- Note [Disconnected type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Aliasing in type and class declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data SameKind (a::k) (b::k) + data T1 (a::k1) (b::k2) c = MkT (SameKind a b) c +We do not allow this, because `k1` and `k2` would both stand for the same type +variable -- they are both aliases for `k`. + +Other examples + data T2 (a::k1) = MkT2 (SameKind a Int) -- k1 stands for Type + data T3 @k1 @k2 (a::k1) (b::k2) = MkT (SameKind a b) -- k1 and k2 are aliases + + type UF :: forall zk. zk -> Constraint + class UF @kk (xb :: k) where -- kk and k are aliases + op :: (xs::kk) -> Bool + +See #24604 for an example that crashed GHC. + +There is a design choice here. It would be possible to allow implicit type variables +like `k1` and `k2` in T1's declartion to stand for /abitrary kinds/. This is in fact +the rule we use in /terms/ pattern signatures: + f :: [Int] -> Int + f ((x::a) : xs) = ... +Here `a` stands for `Int`. But in type /signatures/ we make a different choice: + f1 :: forall (a::k1) (b::k2). SameKind a b -> blah + f2 :: forall (a::k). SameKind a Int -> blah + +Here f1's signature is rejected because `k1` and `k2` are aliased; and f2's is +rejected because `k` stands for `Int`. + +Our current choice is that type and class declarations behave more like signatures; +we do not allow aliasing. That is what `checkForDuplicateScopedTyVars` checks. +See !12328 for some design discussion. + + +Note [Disconnected type variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This note applies when kind-checking the header of a type/class decl that has a separate, standalone kind signature. See #24083. ===================================== libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs ===================================== @@ -1,3 +1,4 @@ +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE Trustworthy #-} ===================================== rts/js/string.js ===================================== @@ -723,7 +723,10 @@ function h$appendToHsStringA(str, appendTo, cc) { function h$appendToHsStringA(str, appendTo) { #endif var i = str.length - 1; - var r = appendTo; + // we need to make an updatable thunk here + // if we embed the given closure in a CONS cell. + // (#24495) + var r = i == 0 ? appendTo : MK_UPD_THUNK(appendTo); while(i>=0) { r = MK_CONS_CC(str.charCodeAt(i), r, cc); --i; ===================================== testsuite/tests/javascript/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T24495: + '$(TEST_HC)' $(TEST_HC_OPTS) T24495.hs -v0 -O1 -dsuppress-uniques -ddump-js -ddump-to-file + ./T24495 + # check that the optimization occurred + grep -c appendToHsStringA T24495.dump-js ===================================== testsuite/tests/javascript/T24495.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE MagicHash #-} +{-# OPTIONS_GHC -O1 #-} +-- -O1 required to make "rest" thunk SingleEntry + +module Main where + +import GHC.CString +import GHC.JS.Prim (JSVal, toJSString) + +foo :: Double -> IO () +foo x = debugString (toJSString ("2 " ++ s)) + where + x' = if x == 0 then "b" else "c" + y' = if x == 0 then "b" else "c" + s = "a" ++ x' ++ " " ++ y' ++ "d" + +main :: IO () +main = foo 0 + + +foreign import javascript "((s) => { console.log(s); })" + debugString :: JSVal -> IO () ===================================== testsuite/tests/javascript/T24495.stdout ===================================== @@ -0,0 +1,2 @@ +2 ab bd +2 ===================================== testsuite/tests/javascript/all.T ===================================== @@ -21,3 +21,4 @@ test('js-mk_tup', extra_files(['test-mk_tup.js']), compile_and_run, ['test-mk_tu test('T23346', normal, compile_and_run, ['']) test('T22455', normal, compile_and_run, ['-ddisable-js-minifier']) test('T23565', normal, compile_and_run, ['']) +test('T24495', normal, makefile_test, ['T24495']) ===================================== testsuite/tests/saks/should_compile/saks018.hs ===================================== @@ -6,4 +6,4 @@ module SAKS_018 where import Data.Kind (Type) type T :: forall k -> k -> Type -data T k (x :: hk) +data T j (x :: j) ===================================== testsuite/tests/saks/should_compile/saks021.hs ===================================== @@ -6,4 +6,4 @@ module SAKS_021 where import Data.Kind (Type) type T :: forall k -> forall (xx :: k) -> Type -data T k (x :: hk) +data T j (x :: j) ===================================== testsuite/tests/saks/should_fail/all.T ===================================== @@ -36,3 +36,5 @@ test('T18863b', normal, compile_fail, ['']) test('T18863c', normal, compile_fail, ['']) test('T18863d', normal, compile_fail, ['']) test('T20916', normal, compile_fail, ['']) +test('saks018-fail', normal, compile_fail, ['']) +test('saks021-fail', normal, compile_fail, ['']) ===================================== testsuite/tests/saks/should_fail/saks018-fail.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE PolyKinds, ExplicitForAll #-} + +module SAKS_018 where + +import Data.Kind (Type) + +type T :: forall k -> k -> Type +data T k (x :: hk) ===================================== testsuite/tests/saks/should_fail/saks018-fail.stderr ===================================== @@ -0,0 +1,4 @@ + +saks018-fail.hs:9:8: error: [GHC-17370] + • Different names for the same type variable: ‘hk’ and ‘k’ + • In the data type declaration for ‘T’ ===================================== testsuite/tests/saks/should_fail/saks021-fail.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE PolyKinds, ExplicitForAll #-} + +module SAKS_021 where + +import Data.Kind (Type) + +type T :: forall k -> forall (xx :: k) -> Type +data T k (x :: hk) ===================================== testsuite/tests/saks/should_fail/saks021-fail.stderr ===================================== @@ -0,0 +1,4 @@ + +saks021-fail.hs:9:8: error: [GHC-17370] + • Different names for the same type variable: ‘hk’ and ‘k’ + • In the data type declaration for ‘T’ ===================================== testsuite/tests/typecheck/should_compile/T24470b.hs ===================================== @@ -7,4 +7,4 @@ import Data.Kind import Data.Data type SynOK :: forall k. k -> Type -type SynOK @t = Proxy :: j -> Type +type SynOK @j = Proxy :: j -> Type ===================================== testsuite/tests/vdq-rta/should_fail/T24604.hs ===================================== @@ -0,0 +1,7 @@ +module T24604 where + +import Data.Kind + +type UF :: forall zk -> zk -> Constraint +class UF kk (xb :: k) where + op :: (xs::kk) -> Bool ===================================== testsuite/tests/vdq-rta/should_fail/T24604.stderr ===================================== @@ -0,0 +1,4 @@ + +T24604.hs:6:10: error: [GHC-17370] + • Different names for the same type variable: ‘k’ and ‘kk’ + • In the class declaration for ‘UF’ ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeAbstractions #-} + +module T24604a where + +import Data.Kind + +type UF :: forall zk. zk -> Constraint +class UF @kk (xb :: k) where + op :: (xs::kk) -> Bool ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.stderr ===================================== @@ -0,0 +1,4 @@ + +T24604a.hs:8:11: error: [GHC-17370] + • Different names for the same type variable: ‘k’ and ‘kk’ + • In the class declaration for ‘UF’ ===================================== testsuite/tests/vdq-rta/should_fail/all.T ===================================== @@ -17,4 +17,6 @@ test('T23738_fail_implicit_tv', normal, compile_fail, ['']) test('T23738_fail_var', normal, compile_fail, ['']) test('T24176', normal, compile_fail, ['']) test('T23739_fail_ret', normal, compile_fail, ['']) -test('T23739_fail_case', normal, compile_fail, ['']) \ No newline at end of file +test('T23739_fail_case', normal, compile_fail, ['']) +test('T24604', normal, compile_fail, ['']) +test('T24604a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e84acd912d4db77a25cb68f434de8f41d30b455...3dffa74229386b4a9a8d4c0de2bee084bc53e0ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e84acd912d4db77a25cb68f434de8f41d30b455...3dffa74229386b4a9a8d4c0de2bee084bc53e0ac You're receiving 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 Apr 2 20:22:48 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 02 Apr 2024 16:22:48 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 18 commits: rts: Fix TSAN_ENABLED CPP guard Message-ID: <660c691883dcf_f9da2b476f0824e4@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - c93eecf1 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 0a2c3c2d by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 6d605aa5 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 447f2ac0 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Spelling, layout, pretty-printing only - - - - - f36b9603 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 7fc8cfc3 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - a818823d by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - c471144d by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - 346115e0 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Remove a long-commented-out line Pure refactoring - - - - - 57f42293 by Simon Peyton Jones at 2024-04-02T21:20:49+01:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - ec584eaf by Simon Peyton Jones at 2024-04-02T21:21:23+01:00 Testsuite message changes from simplifier improvements - - - - - 9c910ae1 by Simon Peyton Jones at 2024-04-02T21:21:23+01:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 15 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/848f360fe1bcbdac28e9cc0014665bf8ccbfd259...9c910ae1a616e74f5389828ad9b9126d0282764e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/848f360fe1bcbdac28e9cc0014665bf8ccbfd259...9c910ae1a616e74f5389828ad9b9126d0282764e You're receiving 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 Apr 2 20:43:17 2024 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 02 Apr 2024 16:43:17 -0400 Subject: [Git][ghc/ghc][wip/template-haskell-stability] 1033 commits: primops: Introduce unsafeThawByteArray# Message-ID: <660c6de5b5ff6_f9da2f9066c8826f@gitlab.mail> Ben Gamari pushed to branch wip/template-haskell-stability at Glasgow Haskell Compiler / GHC Commits: c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04: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 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Andrew Lelechenko at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04: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. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Andrew Lelechenko at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Andrew Lelechenko at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - d0369802 by Simon Peyton Jones at 2023-07-30T09:24:48+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. The Windows numbers vary by 1% espec in benchmarks where the total allocation is low. But the geom mean stays solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp T10421 T13701 T10421 T13701 T12425 Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 42aa7fbd by Julian Ospald at 2023-07-30T17:22:01-04:00 Improve documentation around IOException and ioe_filename See: * https://github.com/haskell/core-libraries-committee/issues/189 * https://github.com/haskell/unix/pull/279 * https://github.com/haskell/unix/pull/289 - - - - - 33598ecb by Sylvain Henry at 2023-08-01T14:45:54-04:00 JS: implement getMonotonicTime (fix #23687) - - - - - d2bedffd by Bartłomiej Cieślar at 2023-08-01T14:46:40-04:00 Implementation of the Deprecated Instances proposal #575 This commit implements the ability to deprecate certain instances, which causes the compiler to emit the desired deprecation message whenever they are instantiated. For example: module A where class C t where instance {-# DEPRECATED "dont use" #-} C Int where module B where import A f :: C t => t f = undefined g :: Int g = f -- "dont use" emitted here The implementation is as follows: - In the parser, we parse deprecations/warnings attached to instances: instance {-# DEPRECATED "msg" #-} Show X deriving instance {-# WARNING "msg2" #-} Eq Y (Note that non-standalone deriving instance declarations do not support this mechanism.) - We store the resulting warning message in `ClsInstDecl` (respectively, `DerivDecl`). In `GHC.Tc.TyCl.Instance.tcClsInstDecl` (respectively, `GHC.Tc.Deriv.Utils.newDerivClsInst`), we pass on that information to `ClsInst` (and eventually store it in `IfaceClsInst` too). - Finally, when we solve a constraint using such an instance, in `GHC.Tc.Instance.Class.matchInstEnv`, we emit the appropriate warning that was stored in `ClsInst`. Note that we only emit a warning when the instance is used in a different module than it is defined, which keeps the behaviour in line with the deprecation of top-level identifiers. Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - d5a65af6 by Ben Gamari at 2023-08-01T14:47:18-04:00 compiler: Style fixes - - - - - 7218c80a by Ben Gamari at 2023-08-01T14:47:19-04:00 rts: Fix implicit cast This ensures that Task.h can be built with a C++ compiler. - - - - - d6d5aafc by Ben Gamari at 2023-08-01T14:47:19-04:00 testsuite: Fix warning in hs_try_putmvar001 - - - - - d9eddf7a by Ben Gamari at 2023-08-01T14:47:19-04:00 testsuite: Add AtomicModifyIORef test - - - - - f9eea4ba by Ben Gamari at 2023-08-01T14:47:19-04:00 rts: Introduce NO_WARN macro This allows fine-grained ignoring of warnings. - - - - - 497b24ec by Ben Gamari at 2023-08-01T14:47:19-04:00 rts: Simplify atomicModifyMutVar2# implementation Previously we would perform a redundant load in the non-threaded RTS in atomicModifyMutVar2# implementation for the benefit of the non-moving GC's write barrier. Eliminate this. - - - - - 52ee082b by Ben Gamari at 2023-08-01T14:47:19-04:00 rts: Introduce more principled fence operations - - - - - cd3c0377 by Ben Gamari at 2023-08-01T14:47:19-04:00 rts: Introduce SET_INFO_RELAXED - - - - - 6df2352a by Ben Gamari at 2023-08-01T14:47:19-04:00 rts: Style fixes - - - - - 4ef6f319 by Ben Gamari at 2023-08-01T14:47:19-04:00 codeGen/tsan: Rework handling of spilling - - - - - f9ca7e27 by Ben Gamari at 2023-08-01T14:47:19-04:00 hadrian: More debug information - - - - - df4153ac by Ben Gamari at 2023-08-01T14:47:19-04:00 Improve TSAN documentation - - - - - fecae988 by Ben Gamari at 2023-08-01T14:47:19-04:00 hadrian: More selective TSAN instrumentation - - - - - 465a9a0b by Alan Zimmerman at 2023-08-01T14:47:56-04:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. Metric Decrease: T9961 T5205 Metric Increase: T13035 - - - - - ae63d0fa by Bartłomiej Cieślar at 2023-08-01T14:48:40-04:00 Add cases to T23279: HasField for deprecated record fields This commit adds additional tests from ticket #23279 to ensure that we don't regress on reporting deprecated record fields in conjunction with HasField, either when using overloaded record dot syntax or directly through `getField`. Fixes #23279 - - - - - 00fb6e6b by Andreas Klebinger at 2023-08-01T14:49:17-04:00 AArch NCG: Pure refactor Combine some alternatives. Add some line breaks for overly long lines - - - - - 8f3b3b78 by Andreas Klebinger at 2023-08-01T14:49:54-04:00 Aarch ncg: Optimize immediate use for address calculations When the offset doesn't fit into the immediate we now just reuse the general getRegister' code path which is well optimized to compute the offset into a register instead of a special case for CmmRegOff. This means we generate a lot less code under certain conditions which is why performance metrics for these improve. ------------------------- Metric Decrease: T4801 T5321FD T5321Fun ------------------------- - - - - - 74a882dc by MorrowM at 2023-08-02T06:00:03-04:00 Add a RULE to make lookup fuse See https://github.com/haskell/core-libraries-committee/issues/175 Metric Increase: T18282 - - - - - cca74dab by Ben Gamari at 2023-08-02T06:00:39-04:00 hadrian: Ensure that way-flags are passed to CC Previously the way-specific compilation flags (e.g. `-DDEBUG`, `-DTHREADED_RTS`) would not be passed to the CC invocations. This meant that C dependency files would not correctly reflect dependencies predicated on the way, resulting in the rather painful #23554. Closes #23554. - - - - - 622b483c by Jaro Reinders at 2023-08-02T06:01:20-04:00 Native 32-bit Enum Int64/Word64 instances This commits adds more performant Enum Int64 and Enum Word64 instances for 32-bit platforms, replacing the Integer-based implementation. These instances are a copy of the Enum Int and Enum Word instances with minimal changes to manipulate Int64 and Word64 instead. On i386 this yields a 1.5x performance increase and for the JavaScript back end it even yields a 5.6x speedup. Metric Decrease: T18964 - - - - - c8bd7fa4 by Sylvain Henry at 2023-08-02T06:02:03-04:00 JS: fix typos in constants (#23650) - - - - - b9d5bfe9 by Josh Meredith at 2023-08-02T06:02:40-04:00 JavaScript: update MK_TUP macros to use current tuple constructors (#23659) - - - - - 28211215 by Matthew Pickering at 2023-08-02T06:03:19-04:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - aca20a5d by Ben Gamari at 2023-08-02T06:03:55-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers By using a proper release store instead of a fence. - - - - - 453c0531 by Ben Gamari at 2023-08-02T06:03:55-04:00 codeGen: Ensure that array reads have necessary barriers This was the cause of #23541. - - - - - 93a0d089 by Arnaud Spiwack at 2023-08-02T06:04:37-04:00 Add test for #23550 - - - - - 6a2f4a20 by Arnaud Spiwack at 2023-08-02T06:04:37-04:00 Desugar non-recursive lets to non-recursive lets (take 2) This reverts commit 522bd584f71ddeda21efdf0917606ce3d81ec6cc. And takes care of the case that I missed in my previous attempt. Namely the case of an AbsBinds with no type variables and no dictionary variable. Ironically, the comment explaining why non-recursive lets were desugared to recursive lets were pointing specifically at this case as the reason. I just failed to understand that it was until Simon PJ pointed it out to me. See #23550 for more discussion. - - - - - ff81d53f by jade at 2023-08-02T06:05:20-04:00 Expand documentation of List & Data.List This commit aims to improve the documentation and examples of symbols exported from Data.List - - - - - fa4e5913 by Jade at 2023-08-02T06:06:03-04:00 Improve documentation of Semigroup & Monoid This commit aims to improve the documentation of various symbols exported from Data.Semigroup and Data.Monoid - - - - - e2c91bff by Gergő Érdi at 2023-08-03T02:55:46+01:00 Desugar bindings in the context of their evidence Closes #23172 - - - - - 481f4a46 by Gergő Érdi at 2023-08-03T07:48:43+01:00 Add flag to `-f{no-}specialise-incoherents` to enable/disable specialisation of incoherent instances Fixes #23287 - - - - - d751c583 by Profpatsch at 2023-08-04T12:24:26-04:00 base: Improve String & IsString documentation - - - - - 01db1117 by Ben Gamari at 2023-08-04T12:25:02-04:00 rts/win32: Ensure reliability of IO manager shutdown When the Win32 threaded IO manager shuts down, `ioManagerDie` sends an `IO_MANAGER_DIE` event to the IO manager thread using the `io_manager_event` event object. Finally, it will closes the event object, and invalidate `io_manager_event`. Previously, `readIOManagerEvent` would see that `io_manager_event` is invalid and return `0`, suggesting that everything is right with the world. This meant that if `ioManagerDie` invalidated the handle before the event manager was blocked on the event we would end up in a situation where the event manager would never realize it was asked to shut down. Fix this by ensuring that `readIOManagerEvent` instead returns `IO_MANAGER_DIE` when we detect that the event object has been invalidated by `ioManagerDie`. Fixes #23691. - - - - - fdef003a by Ryan Scott at 2023-08-04T12:25:39-04:00 Look through TH splices in splitHsApps This modifies `splitHsApps` (a key function used in typechecking function applications) to look through untyped TH splices and quasiquotes. Not doing so was the cause of #21077. This builds on !7821 by making `splitHsApps` match on `HsUntypedSpliceTop`, which contains the `ThModFinalizers` that must be run as part of invoking the TH splice. See the new `Note [Looking through Template Haskell splices in splitHsApps]` in `GHC.Tc.Gen.Head`. Along the way, I needed to make the type of `splitHsApps.set` slightly more general to accommodate the fact that the location attached to a quasiquote is a `SrcAnn NoEpAnns` rather than a `SrcSpanAnnA`. Fixes #21077. - - - - - e77a0b41 by Ben Gamari at 2023-08-04T12:26:15-04:00 Bump deepseq submodule to 1.5. And bump bounds (cherry picked from commit 1228d3a4a08d30eaf0138a52d1be25b38339ef0b) - - - - - cebb5819 by Ben Gamari at 2023-08-04T12:26:15-04:00 configure: Bump minimal boot GHC version to 9.4 (cherry picked from commit d3ffdaf9137705894d15ccc3feff569d64163e8e) - - - - - 83766dbf by Ben Gamari at 2023-08-04T12:26:15-04:00 template-haskell: Bump version to 2.21.0.0 Bumps exceptions submodule. (cherry picked from commit bf57fc9aea1196f97f5adb72c8b56434ca4b87cb) - - - - - 1211112a by Ben Gamari at 2023-08-04T12:26:15-04:00 base: Bump version to 4.19 Updates all boot library submodules. (cherry picked from commit 433d99a3c24a55b14ec09099395e9b9641430143) - - - - - 3ab5efd9 by Ben Gamari at 2023-08-04T12:26:15-04:00 testsuite: Normalise versions more aggressively In backpack hashes can contain `+` characters. (cherry picked from commit 024861af51aee807d800e01e122897166a65ea93) - - - - - d52be957 by Ben Gamari at 2023-08-04T12:26:15-04:00 testsuite: Declare bkpcabal08 as fragile Due to spurious output changes described in #23648. (cherry picked from commit c046a2382420f2be2c4a657c56f8d95f914ea47b) - - - - - e75a58d1 by Ben Gamari at 2023-08-04T12:26:15-04:00 gitlab-ci: Only mark linker_unload_native as broken in static jobs This test passes on dynamically-linked Alpine. (cherry picked from commit f356a7e8ec8ec3d6b2b30fd175598b9b80065d87) - - - - - 8b176514 by Ben Gamari at 2023-08-04T12:26:15-04:00 testsuite: Update base-exports - - - - - 4b647936 by Ben Gamari at 2023-08-04T12:26:15-04:00 testsuite/interface-stability: normalise versions This eliminates spurious changes from version bumps. - - - - - 0eb54c05 by Ben Gamari at 2023-08-04T12:26:51-04:00 linker/PEi386: Don't sign-extend symbol section number Previously we incorrectly interpreted PE section numbers as signed values. However, this isn't the case; rather, it's an unsigned 16-bit number with a few special bit-patterns (0xffff and 0xfffe). This resulted in #22941 as the linker would conclude that the sections were invalid. Fixing this required quite a bit of refactoring. Closes #22941. - - - - - fd7ce39c by Ben Gamari at 2023-08-04T12:27:28-04:00 testsuite: Mark MulMayOflo_full as broken rather than skipping To ensure that we don't accidentally fix it. See #23742. - - - - - 824092f2 by Ben Gamari at 2023-08-04T12:27:28-04:00 nativeGen/AArch64: Fix sign extension in MulMayOflo Previously the 32-bit implementations of MulMayOflo would use the a non-sensical sign-extension mode. Rewrite these to reflect what gcc 11 produces. Also similarly rework the 16- and 8-bit cases. This now passes the MulMayOflo tests in ghc/test-primops> in all four widths, including the precision tests. Fixes #23721. - - - - - 1b15dbc4 by Jan Hrček at 2023-08-04T12:28:08-04:00 Fix haddock markup in code example for coerce - - - - - 46fd8ced by Vladislav Zavialov at 2023-08-04T12:28:44-04:00 Fix (~) and (@) infix operators in TH splices (#23748) 8168b42a "Whitespace-sensitive bang patterns" allows GHC to accept the following infix operators: a ~ b = () a @ b = () But not if TH is used to generate those declarations: $([d| a ~ b = () a @ b = () |]) -- Test.hs:5:2: error: [GHC-55017] -- Illegal variable name: ‘~’ -- When splicing a TH declaration: (~_0) a_1 b_2 = GHC.Tuple.Prim.() This is easily fixed by modifying `reservedOps` in GHC.Utils.Lexeme - - - - - a1899d8f by Aaron Allen at 2023-08-04T12:29:24-04:00 [#23663] Show Flag Suggestions in GHCi Makes suggestions when using `:set` in GHCi with a misspelled flag. This mirrors how invalid flags are handled when passed to GHC directly. Logic for producing flag suggestions was moved to GHC.Driver.Sesssion so it can be shared. resolves #23663 - - - - - 03f2debd by Rodrigo Mesquita at 2023-08-04T12:30:00-04:00 Improve ghc-toolchain validation configure warning Fixes the layout of the ghc-toolchain validation warning produced by configure. - - - - - de25487d by Alan Zimmerman at 2023-08-04T12:30:36-04:00 EPA make getLocA a synonym for getHasLoc This is basically a no-op change, but allows us to make future changes that can rely on the HasLoc instances And I presume this means we can use more precise functions based on class resolution, so the Windows CI build reports Metric Decrease: T12234 T13035 - - - - - 3ac423b9 by Ben Gamari at 2023-08-04T12:31:13-04:00 ghc-platform: Add upper bound on base Hackage upload requires this. - - - - - 8ba20b21 by Matthew Craven at 2023-08-04T17:22:59-04:00 Adjust and clarify handling of primop effects Fixes #17900; fixes #20195. The existing "can_fail" and "has_side_effects" primop attributes that previously governed this were used in inconsistent and confusingly-documented ways, especially with regard to raising exceptions. This patch replaces them with a single "effect" attribute, which has four possible values: NoEffect, CanFail, ThrowsException, and ReadWriteEffect. These are described in Note [Classifying primop effects]. A substantial amount of related documentation has been re-drafted for clarity and accuracy. In the process of making this attribute format change for literally every primop, several existing mis-classifications were detected and corrected. One of these mis-classifications was tagToEnum#, which is now considered CanFail; this particular fix is known to cause a regression in performance for derived Enum instances. (See #23782.) Fixing this is left as future work. New primop attributes "cheap" and "work_free" were also added, and used in the corresponding parts of GHC.Core.Utils. In view of their actual meaning and uses, `primOpOkForSideEffects` and `exprOkForSideEffects` have been renamed to `primOpOkToDiscard` and `exprOkToDiscard`, respectively. Metric Increase: T21839c - - - - - 41bf2c09 by sheaf at 2023-08-04T17:23:42-04:00 Update inert_solved_dicts for ImplicitParams When adding an implicit parameter dictionary to the inert set, we must make sure that it replaces any previous implicit parameter dictionaries that overlap, in order to get the appropriate shadowing behaviour, as in let ?x = 1 in let ?x = 2 in ?x We were already doing this for inert_cans, but we weren't doing the same thing for inert_solved_dicts, which lead to the bug reported in #23761. The fix is thus to make sure that, when handling an implicit parameter dictionary in updInertDicts, we update **both** inert_cans and inert_solved_dicts to ensure a new implicit parameter dictionary correctly shadows old ones. Fixes #23761 - - - - - 43578d60 by Matthew Craven at 2023-08-05T01:05:36-04:00 Bump bytestring submodule to 0.11.5.1 - - - - - 91353622 by Ben Gamari at 2023-08-05T01:06:13-04:00 Initial commit of Note [Thunks, blackholes, and indirections] This Note attempts to summarize the treatment of thunks, thunk update, and indirections. This fell out of work on #23185. - - - - - 8d686854 by sheaf at 2023-08-05T01:06:54-04:00 Remove zonk in tcVTA This removes the zonk in GHC.Tc.Gen.App.tc_inst_forall_arg and its accompanying Note [Visible type application zonk]. Indeed, this zonk is no longer necessary, as we no longer maintain the invariant that types are well-kinded without zonking; only that typeKind does not crash; see Note [The Purely Kinded Type Invariant (PKTI)]. This commit removes this zonking step (as well as a secondary zonk), and replaces the aforementioned Note with the explanatory Note [Type application substitution], which justifies why the substitution performed in tc_inst_forall_arg remains valid without this zonking step. Fixes #23661 - - - - - 19dea673 by Ben Gamari at 2023-08-05T01:07:30-04:00 Bump nofib submodule Ensuring that nofib can be build using the same range of bootstrap compilers as GHC itself. - - - - - aa07402e by Luite Stegeman at 2023-08-05T23:15:55+09:00 JS: Improve compatibility with recent emsdk The JavaScript code in libraries/base/jsbits/base.js had some hardcoded offsets for fields in structs, because we expected the layout of the data structures to remain unchanged. Emsdk 3.1.42 changed the layout of the stat struct, breaking this assumption, and causing code in .hsc files accessing the stat struct to fail. This patch improves compatibility with recent emsdk by removing the assumption that data layouts stay unchanged: 1. offsets of fields in structs used by JavaScript code are now computed by the configure script, so both the .js and .hsc files will automatically use the new layout if anything changes. 2. the distrib/configure script checks that the emsdk version on a user's system is the same version that a bindist was booted with, to avoid data layout inconsistencies See #23641 - - - - - b938950d by Luite Stegeman at 2023-08-07T06:27:51-04:00 JS: Fix missing local variable declarations This fixes some missing local variable declarations that were found by running the testsuite in strict mode. Fixes #23775 - - - - - 6c0e2247 by sheaf at 2023-08-07T13:31:21-04:00 Update Haddock submodule to fix #23368 This submodule update adds the following three commits: bbf1c8ae - Check for puns 0550694e - Remove fake exports for (~), List, and Tuple<n> 5877bceb - Fix pretty-printing of Solo and MkSolo These commits fix the issues with Haddock HTML rendering reported in ticket #23368. Fixes #23368 - - - - - 5b5be3ea by Matthew Pickering at 2023-08-07T13:32:00-04:00 Revert "Bump bytestring submodule to 0.11.5.1" This reverts commit 43578d60bfc478e7277dcd892463cec305400025. Fixes #23789 - - - - - 01961be3 by Ben Gamari at 2023-08-08T02:47:14-04:00 configure: Derive library version from ghc-prim.cabal.in Since ghc-prim.cabal is now generated by Hadrian, we cannot depend upon it. Closes #23726. - - - - - 3b373838 by Ryan Scott at 2023-08-08T02:47:49-04:00 tcExpr: Push expected types for untyped TH splices inwards In !10911, I deleted a `tcExpr` case for `HsUntypedSplice` in favor of a much simpler case that simply delegates to `tcApp`. Although this passed the test suite at the time, this was actually an error, as the previous `tcExpr` case was critically pushing the expected type inwards. This actually matters for programs like the one in #23796, which GHC would not accept with type inference alone—we need full-blown type _checking_ to accept these. I have added back the previous `tcExpr` case for `HsUntypedSplice` and now explain why we have two different `HsUntypedSplice` cases (one in `tcExpr` and another in `splitHsApps`) in `Note [Looking through Template Haskell splices in splitHsApps]` in `GHC.Tc.Gen.Head`. Fixes #23796. - - - - - 0ef1d8ae by sheaf at 2023-08-08T21:26:51-04:00 Compute all emitted diagnostic codes This commit introduces in GHC.Types.Error.Codes the function constructorCodes :: forall diag. (...) => Map DiagnosticCode String which computes a collection of all the diagnostic codes that correspond to a particular type. In particular, we can compute the collection of all diagnostic codes emitted by GHC using the invocation constructorCodes @GhcMessage We then make use of this functionality in the new "codes" test which checks consistency and coverage of GHC diagnostic codes. It performs three checks: - check 1: all non-outdated GhcDiagnosticCode equations are statically used. - check 2: all outdated GhcDiagnosticCode equations are statically unused. - check 3: all statically used diagnostic codes are covered by the testsuite (modulo accepted exceptions). - - - - - 4bc7b1e5 by Fraser Tweedale at 2023-08-08T21:27:32-04:00 numberToRangedRational: fix edge cases for exp ≈ (maxBound :: Int) Currently a negative exponent less than `minBound :: Int` results in Infinity, which is very surprising and obviously wrong. ``` λ> read "1e-9223372036854775808" :: Double 0.0 λ> read "1e-9223372036854775809" :: Double Infinity ``` There is a further edge case where the exponent can overflow when increased by the number of tens places in the integer part, or underflow when decreased by the number of leading zeros in the fractional part if the integer part is zero: ``` λ> read "10e9223372036854775807" :: Double 0.0 λ> read "0.01e-9223372036854775808" :: Double Infinity ``` To resolve both of these issues, perform all arithmetic and comparisons involving the exponent in type `Integer`. This approach also eliminates the need to explicitly check the exponent against `maxBound :: Int` and `minBound :: Int`, because the allowed range of the exponent (i.e. the result of `floatRange` for the target floating point type) is certainly within those bounds. This change implements CLC proposal 192: https://github.com/haskell/core-libraries-committee/issues/192 - - - - - 6eab07b2 by Alan Zimmerman at 2023-08-08T21:28:10-04:00 EPA: Remove Location from WarningTxt source This is not needed. - - - - - 1a98d673 by Sebastian Graf at 2023-08-09T16:24:29-04:00 Cleanup a TODO introduced in 1f94e0f7 The change must have slipped through review of !4412 - - - - - 2274abc8 by Sebastian Graf at 2023-08-09T16:24:29-04:00 More explicit strictness in GHC.Real - - - - - ce8aa54c by Sebastian Graf at 2023-08-09T16:24:30-04:00 exprIsTrivial: Factor out shared implementation The duplication between `exprIsTrivial` and `getIdFromTrivialExpr_maybe` has been bugging me for a long time. This patch introduces an inlinable worker function `trivial_expr_fold` acting as the single, shared decision procedure of triviality. It "returns" a Church-encoded `Maybe (Maybe Id)`, so when it is inlined, it fuses to similar code as before. (Better code, even, in the case of `getIdFromTrivialExpr` which presently allocates a `Just` constructor that cancels away after this patch.) - - - - - d004a36d by Sebastian Graf at 2023-08-09T16:24:30-04:00 Simplify: Simplification of arguments in a single function The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. - - - - - 8c73505e by Sebastian Graf at 2023-08-09T16:24:30-04:00 Core.Ppr: Omit case binder for empty case alternatives A minor improvement to pretty-printing - - - - - d8d993f1 by Sebastian Graf at 2023-08-09T16:24:30-04:00 Disable tests RepPolyWrappedVar2 and RepPolyUnsafeCoerce1 in JS backend ... because those coerce between incompatible/unknown PrimReps. - - - - - f06e87e4 by Sebastian Graf at 2023-08-09T16:24:30-04:00 Inlining literals into boring contexts is OK - - - - - 4a6b7c87 by Sebastian Graf at 2023-08-09T16:24:30-04:00 Clarify floating of unsafeEqualityProofs (#23754) - - - - - b0f4752e by Sebastian Graf at 2023-08-09T16:24:30-04:00 Kill SetLevel.notWorthFloating.is_triv (#23270) We have had it since b84ba676034, when it operated on annotated expressions. Nowadays it operates on vanilla `CoreExpr` though, so we should just call `exprIsTrivial`; thus handling empty cases and string literals correctly. - - - - - 7e0c8b3b by Sebastian Graf at 2023-08-09T16:24:30-04:00 ANFise string literal arguments (#23270) This instates the invariant that a trivial CoreExpr translates to an atomic StgExpr. Nice. Annoyingly, in -O0 we sometimes generate ``` foo = case "blah"# of sat { __DEFAULT -> unpackCString# sat } ``` which makes it a bit harder to spot that we can emit a standard `stg_unpack_cstring` thunk. Fixes #23270. - - - - - 357f2738 by Sebastian Graf at 2023-08-09T16:24:30-04:00 Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) - - - - - 59202c80 by Sebastian Graf at 2023-08-09T16:24:30-04:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. In the ghc/alloc perf test `LargeRecord`, we introduce an additional Simplifier iteration due to #17910. E.g., FloatOut produces a binding ``` lvl_s6uK [Occ=Once1] :: GHC.Types.Int [LclId] lvl_s6uK = GHC.Types.I# 2# lvl_s6uL [Occ=Once1] :: GHC.Types.Any [LclId] lvl_s6uL = case Unsafe.Coerce.unsafeEqualityProof ... of { Unsafe.Coerce.UnsafeRefl v2_i6tr -> lvl_s6uK `cast` (... v2_i6tr ...) } ``` That occurs once and hence is pre-inlined unconditionally in the next Simplifier pass. It's non-trivial to find a way around that, but not really harmful otherwise. Hence we accept a 1.2% increase on some architectures. Metric Increase: LargeRecord - - - - - 00d31188 by Sebastian Graf at 2023-08-09T16:24:30-04:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - bf885d7a by Matthew Craven at 2023-08-09T16:25:07-04:00 Bump bytestring submodule to 0.11.5, again Fixes #23789. The bytestring commit used here is unreleased; a release can be made when necessary. - - - - - 7acbf0fd by Sven Tennie at 2023-08-10T19:17:11-04:00 Serialize CmmRetInfo in .rodata The handling of case was missing. - - - - - 0c3136f2 by Sven Tennie at 2023-08-10T19:17:11-04:00 Reference StgRetFun payload by its struct field address This is easier to grasp than relative pointer offsets. - - - - - f68ff313 by Sven Tennie at 2023-08-10T19:17:11-04:00 Better variable name: u -> frame The 'u' was likely introduced by copy'n'paste. - - - - - 0131bb7f by Sven Tennie at 2023-08-10T19:17:11-04:00 Make checkSTACK() public Such that it can also be used in tests. - - - - - 7b6e1e53 by Sven Tennie at 2023-08-10T19:17:11-04:00 Publish stack related fields in DerivedConstants.h These will be used in ghc-heap to decode these parts of the stack. - - - - - 907ed054 by Sven Tennie at 2023-08-10T19:17:11-04:00 ghc-heap: Decode StgStack and its stack frames Previously, ghc-heap could only decode heap closures. The approach is explained in detail in note [Decoding the stack]. - - - - - 6beb6ac2 by Sven Tennie at 2023-08-10T19:17:11-04:00 Remove RetFunType from RetFun stack frame representation It's a technical detail. The single usage is replaced by a predicate. - - - - - 006bb4f3 by Sven Tennie at 2023-08-10T19:17:11-04:00 Better parameter name The call-site uses the term "offset", too. - - - - - d4c2c1af by Sven Tennie at 2023-08-10T19:17:11-04:00 Make closure boxing pure There seems to be no need to do something complicated. However, the strictness of the closure pointer matters, otherwise a thunk gets decoded. - - - - - 8d8426c9 by Sven Tennie at 2023-08-10T19:17:11-04:00 Document entertainGC in test It wasn't obvious why it's there and what its role is. Also, increase the "entertainment level" a bit. I checked in STG and Cmm dumps that this really generates closures (and is not e.g. constant folded away.) - - - - - cc52c358 by Finley McIlwaine at 2023-08-10T19:17:47-04:00 Add -dipe-stats flag This is useful for seeing which info tables have information. - - - - - 261c4acb by Finley McIlwaine at 2023-08-10T19:17:47-04:00 Add -finfo-table-map-with-fallback -finfo-table-map-with-stack The -fno-info-table-map-with-stack flag omits STACK info tables from the info table map, and the -fno-info-table-map-with-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase the build results were about 7% smaller when both of those types of tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats, which is disabled for the js backend since profiling is not implemented. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. This commit also fixes some issues in the users guide rst source to fix warnings that were noticed while debugging the documentation for these flags. Fixes #23702 - - - - - d7047e0d by Jaro Reinders at 2023-08-14T04:41:42-04:00 Add changelog entry for specialised Enum Int64/Word64 instances - - - - - 52f5e8fb by cydparser at 2023-08-14T04:42:20-04:00 Fix -ddump-to-file and -ddump-timings interaction (#20316) - - - - - 1274c5d6 by cydparser at 2023-08-14T04:42:20-04:00 Update release notes (#20316) - - - - - 8e699b23 by Matthew Pickering at 2023-08-14T10:44:47-04:00 base: Add changelog entry for CLC #188 This proposal modified the implementations of copyBytes, moveBytes and fillBytes (as detailed in the proposal) https://github.com/haskell/core-libraries-committee/issues/188 - - - - - 026f040a by Matthew Pickering at 2023-08-14T10:45:23-04:00 packaging: Build manpage in separate directory to other documentation We were installing two copies of the manpage: * One useless one in the `share/doc` folder, because we copy the doc/ folder into share/ * The one we deliberately installed into `share/man` etc The solution is to build the manpage into the `manpage` directory when building the bindist, and then just install it separately. Fixes #23707 - - - - - 524c60c8 by Bartłomiej Cieślar at 2023-08-14T13:46:33-04:00 Report deprecated fields bound by record wildcards when used This commit ensures that we emit the appropriate warnings when a deprecated record field bound by a record wildcard is used. For example: module A where data Foo = Foo {x :: Int, y :: Bool, z :: Char} {-# DEPRECATED x "Don't use x" #-} {-# WARNING y "Don't use y" #-} module B where import A foo (Foo {..}) = x This will cause us to emit a "Don't use x" warning, with location the location of the record wildcard. Note that we don't warn about `y`, because it is unused in the RHS of `foo`. Fixes #23382 - - - - - d6130065 by Matthew Pickering at 2023-08-14T13:47:11-04:00 Add zstd suffix to jobs which rely on zstd This was causing some confusion as the job was named simply "x86_64-linux-deb10-validate", which implies a standard configuration rather than any dependency on libzstd. - - - - - e24e44fc by Matthew Pickering at 2023-08-14T13:47:11-04:00 ci: Always run project-version job This is needed for the downstream test-primops pipeline to workout what the version of a bindist produced by a pipeline is. - - - - - f17b9d62 by Matthew Pickering at 2023-08-14T13:47:11-04:00 gen_ci: Rework how jobs-metadata.json is generated * We now represent a job group a triple of Maybes, which makes it easier to work out when jobs are enabled/disabled on certain pipelines. ``` data JobGroup a = StandardTriple { v :: Maybe (NamedJob a) , n :: Maybe (NamedJob a) , r :: Maybe (NamedJob a) } ``` * `jobs-metadata.json` generation is reworked using the following algorithm. - For each pipeline type, find all the platforms we are doing builds for. - Select one build per platform - Zip together the results This way we can choose different pipelines for validate/nightly/release which makes the metadata also useful for validate pipelines. This feature is used by the test-primops downstream CI in order to select the right bindist for testing validate pipelines. This makes it easier to inspect which jobs are going to be enabled on a particular pipeline. - - - - - f9a5563d by Matthew Pickering at 2023-08-14T13:47:11-04:00 gen_ci: Rules rework In particular we now distinguish between whether we are dealing with a Nightly/Release pipeline (which labels don't matter for) and a validate pipeline where labels do matter. The overall goal here is to allow a disjunction of labels for validate pipelines, for example, > Run a job if we have the full-ci label or test-primops label Therefore the "ValidateOnly" rules are treated as a set of disjunctions rather than conjunctions like before. What this means in particular is that if we want to ONLY run a job if a label is set, for example, "FreeBSD" label then we have to override the whole label set. Fixes #23772 - - - - - d54b0c1d by Matthew Pickering at 2023-08-14T13:47:11-04:00 ci: set -e for lint-ci-config scripts - - - - - 994a9b35 by Matthew Pickering at 2023-08-14T13:47:11-04:00 ci: Fix job metadata generation - - - - - e194ed2b by Ben Gamari at 2023-08-15T00:58:09-04:00 users-guide: Note that GHC2021 doesn't include ExplicitNamespaces As noted in #23801. - - - - - d814bda9 by Ben Gamari at 2023-08-15T05:43:53-04:00 users-guide: Support both distutils and packaging As noted in #23818, some old distributions (e.g. Debian 9) only include `distutils` while newer distributions only include `packaging`. Fixes #23818. - - - - - 1726db3f by Ben Gamari at 2023-08-15T05:43:53-04:00 users-guide: Ensure extlinks is compatible with Sphinx <4 The semantics of the `extlinks` attribute annoyingly changed in Sphinx 4. Reflect this in our configuration. See #22690. Fixes #23807. - - - - - 173338cf by Matthew Pickering at 2023-08-15T22:00:24-04:00 ci: Run full-ci on master and release branches Fixes #23737 - - - - - bdab6898 by Andrew Lelechenko at 2023-08-15T22:01:03-04:00 Add @since pragmas for Data.Ord.clamp and GHC.Float.clamp - - - - - 662d351b by Matthew Pickering at 2023-08-16T09:35:04-04:00 ghc-toolchain: Match CPP args with configure script At the moment we need ghc-toolchain to precisely match the output as provided by the normal configure script. The normal configure script (FP_HSCPP_CMD_WITH_ARGS) branches on whether we are using clang or gcc so we match that logic exactly in ghc-toolchain. The old implementation (which checks if certain flags are supported) is better but for now we have to match to catch any potential errors in the configuration. Ticket: #23720 - - - - - 09c6759e by Matthew Pickering at 2023-08-16T09:35:04-04:00 configure: Fix `-Wl,--no-as-needed` check The check was failing because the args supplied by $$1 were quoted which failed because then the C compiler thought they were an input file. Fixes #23720 - - - - - 2129678b by Matthew Pickering at 2023-08-16T09:35:04-04:00 configure: Add flag which turns ghc-toolchain check into error We want to catch these errors in CI, but first we need to a flag which turns this check into an error. - - - - - 6e2aa8e0 by Matthew Pickering at 2023-08-16T09:35:04-04:00 ci: Enable --enable-strict-ghc-toolchain-check for all CI jobs This will cause any CI job to fail if we have a mismatch between what ghc-toolchain reports and what ./configure natively reports. Fixing these kinds of issues is highest priority for 9.10 release. - - - - - 12d39e24 by Rodrigo Mesquita at 2023-08-16T09:35:04-04:00 Pass user-specified options to ghc-toolchain The current user interface to configuring target toolchains is `./configure`. In !9263 we added a new tool to configure target toolchains called `ghc-toolchain`, but the blessed way of creating these toolchains is still through configure. However, we were not passing the user-specified options given with the `./configure` invocation to the ghc-toolchain tool. This commit remedies that by storing the user options and environment variables in USER_* variables, which then get passed to GHC-toolchain. The exception to the rule is the windows bundled toolchain, which overrides the USER_* variables with whatever flags the windows bundled toolchain requires to work. We consider the bundled toolchain to be effectively the user specifying options, since the actual user delegated that configuration work. Closes #23678 - - - - - f7b3c3a0 by Rodrigo Mesquita at 2023-08-16T09:35:04-04:00 ghc-toolchain: Parse javascript and ghcjs as a Arch and OS - - - - - 8a0ae4ee by Rodrigo Mesquita at 2023-08-16T09:35:04-04:00 ghc-toolchain: Fix ranlib option - - - - - 31e9ec96 by Rodrigo Mesquita at 2023-08-16T09:35:04-04:00 Check Link Works with -Werror - - - - - bc1998b3 by Matthew Pickering at 2023-08-16T09:35:04-04:00 Only check for no_compact_unwind support on darwin While writing ghc-toolchain we noticed that the FP_PROG_LD_NO_COMPACT_UNWIND check is subtly wrong. Specifically, we pass -Wl,-no_compact_unwind to cc. However, ld.gold interprets this as -n o_compact_unwind, which is a valid argument. Fixes #23676 - - - - - 0283f36e by Matthew Pickering at 2023-08-16T09:35:04-04:00 Add some javascript special cases to ghc-toolchain On javascript there isn't a choice of toolchain but some of the configure checks were not accurately providing the correct answer. 1. The linker was reported as gnu LD because the --version output mentioned gnu LD. 2. The --target flag makes no sense on javascript but it was just ignored by the linker, so we add a special case to stop ghc-toolchain thinking that emcc supports --target when used as a linker. - - - - - a48ec5f8 by Matthew Pickering at 2023-08-16T09:35:04-04:00 check for emcc in gnu_LD check - - - - - 50df2e69 by Matthew Pickering at 2023-08-16T09:35:04-04:00 Add ldOverrideWhitelist to only default to ldOverride on windows/linux On some platforms - ie darwin, javascript etc we really do not want to allow the user to use any linker other than the default one as this leads to all kinds of bugs. Therefore it is a bit more prudant to add a whitelist which specifies on which platforms it might be possible to use a different linker. - - - - - a669a39c by Matthew Pickering at 2023-08-16T09:35:04-04:00 Fix plaform glob in FPTOOLS_SET_C_LD_FLAGS A normal triple may look like x86_64-unknown-linux but when cross-compiling you get $target set to a quad such as.. aarch64-unknown-linux-gnu Which should also match this check. - - - - - c52b6769 by Matthew Pickering at 2023-08-16T09:35:04-04:00 ghc-toolchain: Pass ld-override onto ghc-toolchain - - - - - 039b484f by Matthew Pickering at 2023-08-16T09:35:04-04:00 ld override: Make whitelist override user given option - - - - - d2b63cbc by Matthew Pickering at 2023-08-16T09:35:05-04:00 ghc-toolchain: Add format mode to normalise differences before diffing. The "format" mode takes an "--input" and "--ouput" target file and formats it. This is intended to be useful on windows where the configure/ghc-toolchain target files can't be diffed very easily because the path separators are different. - - - - - f2b39e4a by Matthew Pickering at 2023-08-16T09:35:05-04:00 ghc-toolchain: Bump ci-images commit to get new ghc-wasm-meta We needed to remove -Wno-unused-command-line-argument from the arguments passed in order for the configure check to report correctly. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10976#note_516335 - - - - - 92103830 by Matthew Pickering at 2023-08-16T09:35:05-04:00 configure: MergeObjsCmd - distinguish between empty string and unset variable If `MergeObjsCmd` is explicitly set to the empty string then we should assume that MergeObjs is just not supported. This is especially important for windows where we set MergeObjsCmd to "" in m4/fp_setup_windows_toolchain.m4. - - - - - 3500bb2c by Matthew Pickering at 2023-08-16T09:35:05-04:00 configure: Add proper check to see if object merging works - - - - - 08c9a014 by Matthew Pickering at 2023-08-16T09:35:05-04:00 ghc-toolchain: If MergeObjsCmd is not set, replace setting with Nothing If the user explicitly chooses to not set a MergeObjsCmd then it is correct to use Nothing for tgtMergeObjs field in the Target file. - - - - - c9071d94 by Matthew Pickering at 2023-08-16T09:35:05-04:00 HsCppArgs: Augment the HsCppOptions This is important when we pass -I when setting up the windows toolchain. - - - - - 294a6d80 by Matthew Pickering at 2023-08-16T09:35:05-04:00 Set USER_CPP_ARGS when setting up windows toolchain - - - - - bde4b5d4 by Rodrigo Mesquita at 2023-08-16T09:35:05-04:00 Improve handling of Cc as a fallback - - - - - f4c1c3a3 by Rodrigo Mesquita at 2023-08-16T09:35:05-04:00 ghc-toolchain: Configure Cpp and HsCpp correctly when user specifies flags In ghc-toolchain, we were only /not/ configuring required flags when the user specified any flags at all for the of the HsCpp and Cpp tools. Otherwise, the linker takes into consideration the user specified flags to determine whether to search for a better linker implementation, but already configured the remaining GHC and platform-specific flags regardless of the user options. Other Tools consider the user options as a baseline for further configuration (see `findProgram`), so #23689 is not applicable. Closes #23689 - - - - - bfe4ffac by Matthew Pickering at 2023-08-16T09:35:05-04:00 CPP_ARGS: Put new options after user specified options This matches up with the behaviour of ghc-toolchain, so that the output of both matches. - - - - - a6828173 by Gergő Érdi at 2023-08-16T09:35:41-04:00 If a defaulting plugin made progress, re-zonk wanteds before built-in defaulting Fixes #23821. - - - - - e2b38115 by Sylvain Henry at 2023-08-17T07:54:06-04:00 JS: implement openat(AT_FDCWD...) (#23697) Use `openSync` to implement `openat(AT_FDCWD...)`. - - - - - a975c663 by sheaf at 2023-08-17T07:54:47-04:00 Use unsatisfiable for missing methods w/ defaults When a class instance has an Unsatisfiable constraint in its context and the user has not explicitly provided an implementation of a method, we now always provide a RHS of the form `unsatisfiable @msg`, even if the method has a default definition available. This ensures that, when deferring type errors, users get the appropriate error message instead of a possible runtime loop, if class default methods were defined recursively. Fixes #23816 - - - - - 45ca51e5 by Ben Gamari at 2023-08-17T15:16:41-04:00 ghc-internal: Initial commit of the skeleton - - - - - 88bbf8c5 by Ben Gamari at 2023-08-17T15:16:41-04:00 ghc-experimental: Initial commit - - - - - 664468c0 by Ben Gamari at 2023-08-17T15:17:17-04:00 testsuite/cloneStackLib: Fix incorrect format specifiers - - - - - eaa835bb by Ben Gamari at 2023-08-17T15:17:17-04:00 rts/ipe: Fix const-correctness of IpeBufferListNode Both info tables and the string table should be `const` - - - - - 78f6f6fd by Ben Gamari at 2023-08-17T15:17:17-04:00 nonmoving: Drop dead debugging utilities These are largely superceded by support in the ghc-utils GDB extension. - - - - - 3f6e8f42 by Ben Gamari at 2023-08-17T15:17:17-04:00 nonmoving: Refactor management of mark thread Here we refactor that treatment of the worker thread used by the nonmoving GC for concurrent marking, avoiding creating a new thread with every major GC cycle. As well, the new scheme is considerably easier to reason about, consolidating all state in one place, accessed via a small set of accessors with clear semantics. - - - - - 88c32b7d by Ben Gamari at 2023-08-17T15:17:17-04:00 testsuite: Skip T23221 in nonmoving GC ways This test is very dependent upon GC behavior. - - - - - 381cfaed by Ben Gamari at 2023-08-17T15:17:17-04:00 ghc-heap: Don't expose stack dirty and marking fields These are GC metadata and are not relevant to the end-user. Moreover, they are unstable which makes ghc-heap harder to test than necessary. - - - - - 16828ca5 by Luite Stegeman at 2023-08-21T18:42:53-04:00 bump process submodule to include macOS fix and JS support - - - - - b4d5f6ed by Matthew Pickering at 2023-08-21T18:43:29-04:00 ci: Add support for triggering test-primops pipelines This commit adds 4 ways to trigger testing with test-primops. 1. Applying the ~test-primops label to a validate pipeline. 2. A manually triggered job on a validate pipeline 3. A nightly pipeline job 4. A release pipeline job Fixes #23695 - - - - - 32c50daa by Matthew Pickering at 2023-08-21T18:43:29-04:00 Add test-primops label support The test-primops CI job requires some additional builds in the validation pipeline, so we make sure to enable these jobs when test-primops label is set. - - - - - 73ca8340 by Matthew Pickering at 2023-08-21T18:43:29-04:00 Revert "Aarch ncg: Optimize immediate use for address calculations" This reverts commit 8f3b3b78a8cce3bd463ed175ee933c2aabffc631. See #23793 - - - - - 5546ad9e by Matthew Pickering at 2023-08-21T18:43:29-04:00 Revert "AArch NCG: Pure refactor" This reverts commit 00fb6e6b06598752414a0b9a92840fb6ca61338d. See #23793 - - - - - 02dfcdc2 by Matthew Pickering at 2023-08-21T18:43:29-04:00 Revert "Aarch64 NCG: Use encoded immediates for literals." This reverts commit 40425c5021a9d8eb5e1c1046e2d5fa0a2918f96c. See #23793 ------------------------- Metric Increase: T4801 T5321FD T5321Fun ------------------------- - - - - - 7be4a272 by Matthew Pickering at 2023-08-22T08:55:20+01:00 ci: Remove manually triggered test-ci job This doesn't work on slimmed down pipelines as the needed jobs don't exist. If you want to run test-primops then apply the label. - - - - - 76a4d11b by Jaro Reinders at 2023-08-22T08:08:13-04:00 Remove Ptr example from roles docs - - - - - 069729d3 by Bryan Richter at 2023-08-22T08:08:49-04:00 Guard against duplicate pipelines in forks - - - - - f861423b by Rune K. Svendsen at 2023-08-22T08:09:35-04:00 dump-decls: fix "Ambiguous module name"-error Fixes errors of the following kind, which happen when dump-decls is run on a package that contains a module name that clashes with that of another package. ``` dump-decls: <no location info>: error: Ambiguous module name `System.Console.ANSI.Types': it was found in multiple packages: ansi-terminal-0.11.4 ansi-terminal-types-0.11.5 ``` - - - - - edd8bc43 by Krzysztof Gogolewski at 2023-08-22T12:31:20-04:00 Fix MultiWayIf linearity checking (#23814) Co-authored-by: Thomas BAGREL <thomas.bagrel at tweag.io> - - - - - 4ba088d1 by konsumlamm at 2023-08-22T12:32:02-04:00 Update `Control.Concurrent.*` documentation - - - - - 015886ec by ARATA Mizuki at 2023-08-22T15:13:13-04:00 Support 128-bit SIMD on AArch64 via LLVM backend - - - - - 52a6d868 by Krzysztof Gogolewski at 2023-08-22T15:13:51-04:00 Testsuite cleanup - Remove misleading help text in perf_notes, ways are not metrics - Remove no_print_summary - this was used for Phabricator - In linters tests, run 'git ls-files' just once. Previously, it was called on each has_ls_files() - Add ghc-prim.cabal to gitignore, noticed in #23726 - Remove ghc-prim.cabal, it was accidentally committed in 524c60c8cd - - - - - ab40aa52 by Alan Zimmerman at 2023-08-22T15:14:28-04:00 EPA: Use Introduce [DeclTag] in AnnSortKey The AnnSortKey is used to keep track of the order of declarations for printing when the container has split them apart. This applies to HsValBinds and ClassDecl, ClsInstDecl. When making modifications to the list of declarations, the new order must be captured for when it must be printed. For each list of declarations (binds and sigs for a HsValBind) we can just store the list in order. To recreate the list when printing, we must merge them, and this is what the AnnSortKey records. It used to be indexed by SrcSpan, we now simply index by a marker as to which list to take the next item from. - - - - - e7db36c1 by sheaf at 2023-08-23T08:41:28-04:00 Don't attempt pattern synonym error recovery This commit gets rid of the pattern synonym error recovery mechanism (recoverPSB). The rationale is that the fake pattern synonym binding that the recovery mechanism introduced could lead to undesirable knock-on errors, and it isn't really feasible to conjure up a satisfactory binding as pattern synonyms can be used both in expressions and patterns. See Note [Pattern synonym error recovery] in GHC.Tc.TyCl.PatSyn. It isn't such a big deal to eagerly fail compilation on a pattern synonym that doesn't typecheck anyway. Fixes #23467 - - - - - 6ccd9d65 by Ben Gamari at 2023-08-23T08:42:05-04:00 base: Don't use Data.ByteString.Internals.memcpy This function is now deprecated from `bytestring`. Use `Foreign.Marshal.Utils.copyBytes` instead. Fixes #23880. - - - - - 0bfa0031 by Matthew Pickering at 2023-08-23T13:43:48-04:00 hadrian: Uniformly pass buildOptions to all builders in runBuilder In Builder.hs, runBuilderWith mostly ignores the buildOptions in BuildInfo. This leads to hard to diagnose bugs as any build options you pass with runBuilderWithCmdOptions are ignored for many builders. Solution: Uniformly pass buildOptions to the invocation of cmd. Fixes #23845 - - - - - 9cac8f11 by Matthew Pickering at 2023-08-23T13:43:48-04:00 Abstract windows toolchain setup This commit splits up the windows toolchain setup logic into two functions. * FP_INSTALL_WINDOWS_TOOLCHAIN - deals with downloading the toolchain if it isn't already downloaded * FP_SETUP_WINDOWS_TOOLCHAIN - sets the environment variables to point to the correct place FP_SETUP_WINDOWS_TOOLCHAIN is abstracted from the location of the mingw toolchain and also the eventual location where we will install the toolchain in the installed bindist. This is the first step towards #23608 - - - - - 6c043187 by Matthew Pickering at 2023-08-23T13:43:48-04:00 Generate build.mk for bindists The config.mk.in script was relying on some variables which were supposed to be set by build.mk but therefore never were when used to install a bindist. Specifically * BUILD_PROF_LIBS to determine whether we had profiled libraries or not * DYNAMIC_GHC_PROGRAMS to determine whether we had shared libraries or not Not only were these never set but also not really accurate because you could have shared libaries but still statically linked ghc executable. In addition variables like GhcLibWays were just never used, so those have been deleted from the script. Now instead we generate a build.mk file which just directly specifies which RtsWays we have supplied in the bindist and whether we have DYNAMIC_GHC_PROGRAMS. - - - - - fe23629b by Matthew Pickering at 2023-08-23T13:43:48-04:00 hadrian: Add reloc-binary-dist-* targets This adds a command line option to build a "relocatable" bindist. The bindist is created by first creating a normal bindist and then installing it using the `RelocatableBuild=YES` option. This creates a bindist without any wrapper scripts pointing to the libdir. The motivation for this feature is that we want to ship relocatable bindists on windows and this method is more uniform than the ad-hoc method which lead to bugs such as #23608 and #23476 The relocatable bindist can be built with the "reloc-binary-dist" target and supports the same suffixes as the normal "binary-dist" command to specify the compression style. - - - - - 41cbaf44 by Matthew Pickering at 2023-08-23T13:43:48-04:00 packaging: Fix installation scripts on windows/RelocatableBuild case This includes quite a lot of small fixes which fix the installation makefile to work on windows properly. This also required fixing the RelocatableBuild variable which seemed to have been broken for a long while. Sam helped me a lot writing this patch by providing a windows machine to test the changes. Without him it would have taken ages to tweak everything. Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - 03474456 by Matthew Pickering at 2023-08-23T13:43:48-04:00 ci: Build relocatable bindist on windows We now build the relocatable bindist target on windows, which means we test and distribute the new method of creating a relocatable bindist. - - - - - d0b48113 by Matthew Pickering at 2023-08-23T13:43:48-04:00 hadrian: Add error when trying to build binary-dist target on windows The binary dist produced by `binary-dist` target doesn't work on windows because of the wrapper script the makefile installs. In order to not surprise any packagers we just give an error if someone tries to build the old binary-dist target rather than the reloc-binary-dist target. - - - - - 7cbf9361 by Matthew Pickering at 2023-08-23T13:43:48-04:00 hadrian: Remove query' logic to use tooldir - - - - - 03fad42e by Matthew Pickering at 2023-08-23T13:43:48-04:00 configure: Set WindresCmd directly and removed unused variables For some reason there was an indirection via the Windres variable before setting WindresCmd. That indirection led to #23855. I then also noticed that these other variables were just not used anywhere when trying to work out what the correct condition was for this bit of the configure script. - - - - - c82770f5 by sheaf at 2023-08-23T13:43:48-04:00 Apply shellcheck suggestion to SUBST_TOOLDIR - - - - - 896e35e5 by sheaf at 2023-08-23T13:44:34-04:00 Compute hints from TcSolverReportMsg This commit changes how hints are handled in conjunction with constraint solver report messages. Instead of storing `[GhcHint]` in the TcRnSolverReport error constructor, we compute the hints depending on the underlying TcSolverReportMsg. This disentangles the logic and makes it easier to add new hints for certain errors. - - - - - a05cdaf0 by Alexander Esgen at 2023-08-23T13:45:16-04:00 users-guide: remove note about fatal Haddock parse failures - - - - - 4908d798 by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Introduce Data.Enum - - - - - f59707c7 by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add export list to GHC.Num.Integer - - - - - b1054053 by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add export list to GHC.Num - - - - - 6baa481d by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add export list to GHC.Num.Natural - - - - - 2ac15233 by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add export list to GHC.Float - - - - - f3c489de by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add export list to GHC.Real - - - - - 94f59eaa by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Eliminate module reexport in GHC.Exception The metric increase here isn't strictly due to this commit but it's a rather small, incidental change. Metric Increase: T8095 T13386 Metric Decrease: T8095 T13386 T18304 - - - - - be1fc7df by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add disclaimers in internal modules To warn users that these modules are internal and their interfaces may change with little warning. As proposed in Core Libraries Committee #146 [CLC146]. [CLC146]: https://github.com/haskell/core-libraries-committee/issues/146 - - - - - 0326f3f4 by sheaf at 2023-08-23T17:37:29-04:00 Bump Cabal submodule We need to bump the Cabal submodule to include commit ec75950 which fixes an issue with a dodgy import Rep(..) which relied on GHC bug #23570 - - - - - 0504cd08 by Facundo Domínguez at 2023-08-23T17:38:11-04:00 Fix typos in the documentation of Data.OldList.permutations - - - - - 1420b8cb by Antoine Leblanc at 2023-08-24T16:18:17-04:00 Be more eager in TyCon boot validity checking This commit performs boot-file consistency checking for TyCons into checkValidTyCl. This ensures that we eagerly catch any mismatches, which prevents the compiler from seeing these inconsistencies and panicking as a result. See Note [TyCon boot consistency checking] in GHC.Tc.TyCl. Fixes #16127 - - - - - d99c816f by Finley McIlwaine at 2023-08-24T16:18:55-04:00 Refactor estimation of stack info table provenance This commit greatly refactors the way we compute estimated provenance for stack info tables. Previously, this process was done using an entirely separate traversal of the whole Cmm code stream to build the map from info tables to source locations. The separate traversal is now fused with the Cmm code generation pipeline in GHC.Driver.Main. This results in very significant code generation speed ups when -finfo-table-map is enabled. In testing, this patch reduces code generation times by almost 30% with -finfo-table-map and -O0, and 60% with -finfo-table-map and -O1 or -O2 . Fixes #23103 - - - - - d3e0124c by Finley McIlwaine at 2023-08-24T16:18:55-04:00 Add a test checking overhead of -finfo-table-map We want to make sure we don't end up with poor codegen performance resulting from -finfo-table-map again as in #23103. This test adds a performance test tracking total allocations while compiling ExactPrint with -finfo-table-map. - - - - - fcfc1777 by Ben Gamari at 2023-08-25T10:58:16-04:00 llvmGen: Add export list to GHC.Llvm.MetaData - - - - - 5880fff6 by Ben Gamari at 2023-08-25T10:58:16-04:00 llvmGen: Allow LlvmLits in MetaExprs This omission appears to be an oversight. - - - - - 86ce92a2 by Ben Gamari at 2023-08-25T10:58:16-04:00 compiler: Move platform feature predicates to GHC.Driver.DynFlags These are useful in `GHC.Driver.Config.*`. - - - - - a6a38742 by Ben Gamari at 2023-08-25T10:58:16-04:00 llvmGen: Introduce infrastructure for module flag metadata - - - - - e9af2cf3 by Ben Gamari at 2023-08-25T10:58:16-04:00 llvmGen: Don't pass stack alignment via command line As of https://reviews.llvm.org/D103048 LLVM no longer supports the `-stack-alignment=...` flag. Instead this information is passed via a module flag metadata node. This requires dropping support for LLVM 11 and 12. Fixes #23870 - - - - - a936f244 by Alan Zimmerman at 2023-08-25T10:58:56-04:00 EPA: Keep track of "in" token for WarningTxt category A warning can now be written with a category, e.g. {-# WARNInG in "x-c" e "d" #-} Keep track of the location of the 'in' keyword and string, as well as the original SourceText of the label, in case it uses character escapes. - - - - - 3df8a653 by Matthew Pickering at 2023-08-25T17:42:18-04:00 Remove redundant import in InfoTableProv The copyBytes function is provided by the import of Foreign. Fixes #23889 - - - - - d6f807ec by Ben Gamari at 2023-08-25T17:42:54-04:00 gitlab/issue-template: Mention report-a-bug - - - - - 50b9f75d by Artin Ghasivand at 2023-08-26T20:02:50+03:30 Added StandaloneKindSignature examples to replace CUSKs ones - - - - - 2f6309a4 by Vladislav Zavialov at 2023-08-27T03:47:37-04:00 Remove outdated CPP in compiler/* and template-haskell/* The boot compiler was bumped to 9.4 in cebb5819b43. There is no point supporting older GHC versions with CPP. - - - - - 5248fdf7 by Zubin Duggal at 2023-08-28T15:01:09+05:30 testsuite: Add regression test for #23861 Simon says this was fixed by commit 8d68685468d0b6e922332a3ee8c7541efbe46137 Author: sheaf <sam.derbyshire at gmail.com> Date: Fri Aug 4 15:28:45 2023 +0200 Remove zonk in tcVTA - - - - - b6903f4d by Zubin Duggal at 2023-08-28T12:33:58-04:00 testsuite: Add regression test for #23864 Simon says this was fixed by commit 59202c800f2c97c16906120ab2561f6e1556e4af Author: Sebastian Graf <sebastian.graf at kit.edu> Date: Fri Mar 31 17:35:22 2023 +0200 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. - - - - - 9eecdf33 by sheaf at 2023-08-28T18:54:06+00:00 Remove ScopedTypeVariables => TypeAbstractions This commit implements [amendment 604](https://github.com/ghc-proposals/ghc-proposals/pull/604/) to [GHC proposal 448](https://github.com/ghc-proposals/ghc-proposals/pull/448) by removing the implication of language extensions ScopedTypeVariables => TypeAbstractions To limit breakage, we now allow type arguments in constructor patterns when both ScopedTypeVariables and TypeApplications are enabled, but we emit a warning notifying the user that this is deprecated behaviour that will go away starting in GHC 9.12. Fixes #23776 - - - - - fadd5b4d by sheaf at 2023-08-28T18:54:06+00:00 .stderr: ScopedTypeVariables =/> TypeAbstractions This commit accepts testsuite changes for the changes in the previous commit, which mean that TypeAbstractions is no longer implied by ScopedTypeVariables. - - - - - 4f5fb500 by Greg Steuck at 2023-08-29T07:55:13-04:00 Repair `codes` test on OpenBSD by explicitly requesting extended RE - - - - - 6bbde581 by Vasily Sterekhov at 2023-08-29T12:06:58-04:00 Add test for #23540 `T23540.hs` makes use of `explainEv` from `HieQueries.hs`, so `explainEv` has been moved to `TestUtils.hs`. - - - - - 257bb3bd by Vasily Sterekhov at 2023-08-29T12:06:58-04:00 Add test for #23120 - - - - - 4f192947 by Vasily Sterekhov at 2023-08-29T12:06:58-04:00 Make some evidence uses reachable by toHie Resolves #23540, #23120 This adds spans to certain expressions in the typechecker and renamer, and lets 'toHie' make use of those spans. Therefore the relevant evidence uses for the following syntax will now show up under the expected nodes in 'HieAst's: - Overloaded literals ('IsString', 'Num', 'Fractional') - Natural patterns and N+k patterns ('Eq', 'Ord', and instances from the overloaded literals being matched on) - Arithmetic sequences ('Enum') - Monadic bind statements ('Monad') - Monadic body statements ('Monad', 'Alternative') - ApplicativeDo ('Applicative', 'Functor') - Overloaded lists ('IsList') Also see Note [Source locations for implicit function calls] In the process of handling overloaded lists I added an extra 'SrcSpan' field to 'VAExpansion' - this allows us to more accurately reconstruct the locations from the renamer in 'rebuildHsApps'. This also happens to fix #23120. See the additions to Note [Looking through HsExpanded] - - - - - fe9fcf9d by Sylvain Henry at 2023-08-29T12:07:50-04:00 ghc-heap: rename C file (fix #23898) - - - - - b60d6576 by Krzysztof Gogolewski at 2023-08-29T12:08:29-04:00 Misc cleanup - Builtin.PrimOps: ReturnsAlg was used only for unboxed tuples. Rename to ReturnsTuple. - Builtin.Utils: use SDoc for a panic message. The comment about <<details unavailable>> was obsoleted by e8d356773b56. - TagCheck: fix wrong logic. It was zipping a list 'args' with its version 'args_cmm' after filtering. - Core.Type: remove an outdated 1999 comment about unlifted polymorphic types - hadrian: remove leftover debugging print - - - - - 3054fd6d by Krzysztof Gogolewski at 2023-08-29T12:09:08-04:00 Add a regression test for #23903 The bug has been fixed by commit bad2f8b8aa8424. - - - - - 21584b12 by Ben Gamari at 2023-08-29T19:52:02-04:00 README: Refer to ghc-hq repository for contributor and governance information - - - - - e542d590 by sheaf at 2023-08-29T19:52:40-04:00 Export setInertSet from GHC.Tc.Solver.Monad We used to export getTcSInerts and setTcSInerts from GHC.Tc.Solver.Monad. These got renamed to getInertSet/setInertSet in e1590ddc. That commit also removed the export of setInertSet, but that function is useful for the GHC API. - - - - - 694ec5b1 by sheaf at 2023-08-30T10:18:32-04:00 Don't bundle children for non-parent Avails We used to bundle all children of the parent Avail with things that aren't the parent, e.g. with class C a where type T a meth :: .. we would bundle the whole Avail (C, T, meth) with all of C, T and meth, instead of only with C. Avoiding this fixes #23570 - - - - - d926380d by Krzysztof Gogolewski at 2023-08-30T10:19:08-04:00 Fix typos - - - - - d07080d2 by Josh Meredith at 2023-08-30T19:42:32-04:00 JS: Implement missing C functions `rename`, `realpath`, and `getcwd` (#23806) - - - - - e2940272 by David Binder at 2023-08-30T19:43:08-04:00 Bump submodules of hpc and hpc-bin to version 0.7.0.0 hpc 0.7.0.0 dropped SafeHaskell safety guarantees in order to simplify compatibility with newer versions of the directory package which dropped all SafeHaskell guarantees. - - - - - 5d56d05c by David Binder at 2023-08-30T19:43:08-04:00 Bump hpc bound in ghc.cabal.in - - - - - 99fff496 by Dominik Schrempf at 2023-08-31T00:04:46-04:00 ghc classes documentation: rm redundant comment - - - - - fe021bab by Dominik Schrempf at 2023-08-31T00:04:46-04:00 prelude documentation: various nits - - - - - 48c84547 by Dominik Schrempf at 2023-08-31T00:04:46-04:00 integer documentation: minor corrections - - - - - 20cd12f4 by Dominik Schrempf at 2023-08-31T00:04:46-04:00 real documentation: nits - - - - - dd39bdc0 by sheaf at 2023-08-31T00:05:27-04:00 Add a test for #21765 This issue (of reporting a constraint as being redundant even though removing it causes typechecking to fail) was fixed in aed1974e. This commit simply adds a regression test. Fixes #21765 - - - - - f1ec3628 by Andrew Lelechenko at 2023-08-31T23:53:30-04:00 Export foldl' from Prelude and bump submodules See https://github.com/haskell/core-libraries-committee/issues/167 for discussion Metric Decrease: T8095 T13386 Metric Increase: T13386 T8095 T8095 ghc/alloc decreased on x86_64, but increased on aarch64. T13386 ghc/alloc decreased on x86_64-windows, but increased on other platforms. Neither has anything to do with `foldl'`, so I conclude that both are flaky. - - - - - 3181b97d by Gergő Érdi at 2023-08-31T23:54:06-04:00 Allow cross-tyvar defaulting proposals from plugins Fixes #23832. - - - - - e4af506e by Sebastian Graf at 2023-09-01T14:29:12-04:00 Clarify Note [GlobalId/LocalId] after CorePrep (#23797) Fixes #23797. - - - - - ac29787c by Sylvain Henry at 2023-09-01T14:30:02-04:00 Fix warning with UNPACK on sum type (#23921) - - - - - 9765ac7b by Zubin Duggal at 2023-09-05T00:37:45-04:00 hadrian: track python dependencies in doc rules - - - - - 1578215f by sheaf at 2023-09-05T00:38:26-04:00 Bump Haddock to fix #23616 This commit updates the Haddock submodule to include the fix to #23616. Fixes #23616 - - - - - 5a2fe35a by David Binder at 2023-09-05T00:39:07-04:00 Fix example in GHC user guide in SafeHaskell section The example given in the SafeHaskell section uses an implementation of Monad which no longer works. This MR removes the non-canonical return instance and adds the necessary instances of Functor and Applicative. - - - - - 291d81ae by Matthew Pickering at 2023-09-05T14:03:10-04:00 driver: Check transitive closure of haskell package dependencies when deciding whether to relink We were previously just checking whether direct package dependencies had been modified. This caused issues when compiling without optimisations as we wouldn't relink the direct dependency if one of its dependenices changed. Fixes #23724 - - - - - 35da0775 by Krzysztof Gogolewski at 2023-09-05T14:03:47-04:00 Re-export GHC.Utils.Panic.Plain from GHC.Utils.Panic Fixes #23930 - - - - - 3930d793 by Jaro Reinders at 2023-09-06T18:42:55-04:00 Make STG rewriter produce updatable closures - - - - - 0104221a by Krzysztof Gogolewski at 2023-09-06T18:43:32-04:00 configure: update message to use hadrian (#22616) - - - - - b34f8586 by Alan Zimmerman at 2023-09-07T10:58:38-04:00 EPA: Incorrect locations for UserTyVar with '@' In T13343.hs, the location for the @ is not within the span of the surrounding UserTyVar. type Bad @v = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v Widen it so it is captured. Closes #23887 - - - - - 8046f020 by Finley McIlwaine at 2023-09-07T10:59:15-04:00 Bump haddock submodule to fix #23920 Removes the fake export of `FUN` from Prelude. Fixes #23920. Bumps haddock submodule. - - - - - e0aa8c6e by Krzysztof Gogolewski at 2023-09-07T11:00:03-04:00 Fix wrong role in mkSelCo_maybe In the Lint failure in #23938, we start with a coercion Refl :: T a ~R T a, and call mkSelCo (SelTyCon 1 nominal) Refl. The function incorrectly returned Refl :: a ~R a. The returned role should be nominal, according to the SelCo rule: co : (T s1..sn) ~r0 (T t1..tn) r = tyConRole tc r0 i ---------------------------------- SelCo (SelTyCon i r) : si ~r ti In this test case, r is nominal while r0 is representational. - - - - - 1d92f2df by Gergő Érdi at 2023-09-08T04:04:30-04:00 If we have multiple defaulting plugins, then we should zonk in between them after any defaulting has taken place, to avoid a defaulting plugin seeing a metavariable that has already been filled. Fixes #23821. - - - - - eaee4d29 by Gergő Érdi at 2023-09-08T04:04:30-04:00 Improvements to the documentation of defaulting plugins Based on @simonpj's draft and comments in !11117 - - - - - ede3df27 by Alan Zimmerman at 2023-09-08T04:05:06-04:00 EPA: Incorrect span for LWarnDec GhcPs The code (from T23465.hs) {-# WARNInG in "x-c" e "d" #-} e = e gives an incorrect span for the LWarnDecl GhcPs Closes #23892 It also fixes the Test23465/Test23464 mixup - - - - - a0ccef7a by Krzysztof Gogolewski at 2023-09-08T04:05:42-04:00 Valid hole fits: don't suggest unsafeCoerce (#17940) - - - - - 88b942c4 by Oleg Grenrus at 2023-09-08T19:58:42-04:00 Add warning for badly staged types. Resolves #23829. The stage violation results in out-of-bound names in splices. Technically this is an error, but someone might rely on this!? Internal changes: - we now track stages for TyVars. - thLevel (RunSplice _) = 0, instead of panic, as reifyInstances does in fact rename its argument type, and it can contain variables. - - - - - 9861f787 by Ben Gamari at 2023-09-08T19:59:19-04:00 rts: Fix invalid symbol type I suspect this code is dead since we haven't observed this failing despite the obviously incorrect macro name. - - - - - 03ed6a9a by Ben Gamari at 2023-09-08T19:59:19-04:00 testsuite: Add simple test exercising C11 atomics in GHCi See #22012. - - - - - 1aa5733a by Ben Gamari at 2023-09-08T19:59:19-04:00 rts/RtsSymbols: Add AArch64 outline atomic operations Fixes #22012 by adding the symbols described in https://github.com/llvm/llvm-project/blob/main/llvm/docs/Atomics.rst#libcalls-atomic. Ultimately this would be better addressed by #22011, but this is a first step in the right direction and fixes the immediate symptom. Note that we dropped the `__arch64_cas16` operations as these provided by all platforms's compilers. Also, we don't link directly against the libgcc/compiler-rt definitions but rather provide our own wrappers to work around broken toolchains (e.g. https://bugs.gentoo.org/868018). Generated via https://gitlab.haskell.org/ghc/ghc/-/snippets/5733. - - - - - 8f7d3041 by Matthew Pickering at 2023-09-08T19:59:55-04:00 ci: Build debian12 and fedora38 bindists This adds builds for the latest releases for fedora and debian We build these bindists in nightly and release pipelines. - - - - - a1f0d55c by Felix Leitz at 2023-09-08T20:00:37-04:00 Fix documentation around extension implication for MultiParamTypeClasses/ConstrainedClassMethods. - - - - - 98166389 by Teo Camarasu at 2023-09-12T04:30:54-04:00 docs: move -xn flag beside --nonmoving-gc It makes sense to have these beside each other as they are aliases. - - - - - f367835c by Teo Camarasu at 2023-09-12T04:30:55-04:00 nonmoving: introduce a family of dense allocators Supplement the existing power 2 sized nonmoving allocators with a family of dense allocators up to a configurable threshold. This should reduce waste from rounding up block sizes while keeping the amount of allocator sizes manageable. This patch: - Adds a new configuration option `--nonmoving-dense-allocator-count` to control the amount of these new dense allocators. - Adds some constants to `NonmovingAllocator` in order to keep marking fast with the new allocators. Resolves #23340 - - - - - 2b07bf2e by Teo Camarasu at 2023-09-12T04:30:55-04:00 Add changelog entry for #23340 - - - - - f96fe681 by sheaf at 2023-09-12T04:31:44-04:00 Use printGhciException in run{Stmt, Decls} When evaluating statements in GHCi, we need to use printGhciException instead of the printException function that GHC provides in order to get the appropriate error messages that are customised for ghci use. - - - - - d09b932b by psilospore at 2023-09-12T04:31:44-04:00 T23686: Suggest how to enable Language Extension when in ghci Fixes #23686 - - - - - da30f0be by Matthew Craven at 2023-09-12T04:32:24-04:00 Unarise: Split Rubbish literals in function args Fixes #23914. Also adds a check to STG lint that these args are properly unary or nullary after unarisation - - - - - 261b6747 by Matthew Pickering at 2023-09-12T04:33:04-04:00 darwin: Bump MAXOSX_DEPLOYMENT_TARGET to 10.13 This bumps the minumum supported version to 10.13 (High Sierra) which is 6 years old at this point. Fixes #22938 - - - - - f418f919 by Mario Blažević at 2023-09-12T04:33:45-04:00 Fix TH pretty-printing of nested GADTs, issue #23937 This commit fixes `Language.Haskell.TH.Ppr.pprint` so that it correctly pretty-prints GADTs declarations contained within data family instances. Fixes #23937 - - - - - d7a64753 by John Ericson at 2023-09-12T04:34:20-04:00 Put hadrian non-bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. This is picking up where ad8cfed4195b1bbfc15b841f010e75e71f63157d left off. - - - - - ff0a709a by Sylvain Henry at 2023-09-12T08:46:28-04:00 JS: fix some tests - Tests using Setup programs need to pass --with-hc-pkg - Several other fixes See https://gitlab.haskell.org/ghc/ghc/-/wikis/javascript-backend/bug_triage for the current status - - - - - fc86f0e7 by Krzysztof Gogolewski at 2023-09-12T08:47:04-04:00 Fix in-scope set assertion failure (#23918) Patch by Simon - - - - - 21a906c2 by Matthew Pickering at 2023-09-12T17:21:04+02:00 Add -Winconsistent-flags warning The warning fires when inconsistent command line flags are passed. For example: * -dynamic-too and -dynamic * -dynamic-too on windows * -O and --interactive * etc This is on by default and allows users to control whether the warning is displayed and whether it should be an error or not. Fixes #22572 - - - - - dfc4f426 by Krzysztof Gogolewski at 2023-09-12T20:31:35-04:00 Avoid serializing BCOs with the internal interpreter Refs #23919 - - - - - 9217950b by Finley McIlwaine at 2023-09-13T08:06:03-04:00 Fix numa auto configure - - - - - 98e7c1cf by Simon Peyton Jones at 2023-09-13T08:06:40-04:00 Add -fno-cse to T15426 and T18964 This -fno-cse change is to avoid these performance tests depending on flukey CSE stuff. Each contains several independent tests, and we don't want them to interact. See #23925. By killing CSE we expect a 400% increase in T15426, and 100% in T18964. Metric Increase: T15426 T18964 - - - - - 236a134e by Simon Peyton Jones at 2023-09-13T08:06:40-04:00 Tiny refactor canEtaReduceToArity was only called internally, and always with two arguments equal to zero. This patch just specialises the function, and renames it to cantEtaReduceFun. No change in behaviour. - - - - - 56b403c9 by Ben Gamari at 2023-09-13T19:21:36-04:00 spec-constr: Lift argument limit for SPEC-marked functions When the user adds a SPEC argument to a function, they are informing us that they expect the function to be specialised. However, previously this instruction could be preempted by the specialised-argument limit (sc_max_args). Fix this. This fixes #14003. - - - - - 6840012e by Simon Peyton Jones at 2023-09-13T19:22:13-04:00 Fix eta reduction Issue #23922 showed that GHC was bogusly eta-reducing a join point. We should never eta-reduce (\x -> j x) to j, if j is a join point. It is extremly difficult to trigger this bug. It took me 45 mins of trying to make a small tests case, here immortalised as T23922a. - - - - - e5c00092 by Andreas Klebinger at 2023-09-14T08:57:43-04:00 Profiling: Properly escape characters when using `-pj`. There are some ways in which unusual characters like quotes or others can make it into cost centre names. So properly escape these. Fixes #23924 - - - - - ec490578 by Ellie Hermaszewska at 2023-09-14T08:58:24-04:00 Use clearer example variable names for bool eliminator - - - - - 5126a2fe by Sylvain Henry at 2023-09-15T11:18:02-04:00 Add missing int64/word64-to-double/float rules (#23907) CLC proposal: https://github.com/haskell/core-libraries-committee/issues/203 - - - - - 566ef411 by Mario Blažević at 2023-09-15T11:18:43-04:00 Fix and test TH pretty-printing of type operator role declarations This commit fixes and tests `Language.Haskell.TH.Ppr.pprint` so that it correctly pretty-prints `type role` declarations for operator names. Fixes #23954 - - - - - 8e05c54a by Simon Peyton Jones at 2023-09-16T01:42:33-04:00 Use correct FunTyFlag in adjustJoinPointType As the Lint error in #23952 showed, the function adjustJoinPointType was failing to adjust the FunTyFlag when adjusting the type. I don't think this caused the seg-fault reported in the ticket, but it is definitely. This patch fixes it. It is tricky to come up a small test case; Krzysztof came up with this one, but it only triggers a failure in GHC 9.6. - - - - - 778c84b6 by Pierre Le Marre at 2023-09-16T01:43:15-04:00 Update to Unicode 15.1.0 See: https://www.unicode.org/versions/Unicode15.1.0/ - - - - - f9d79a6c by Alan Zimmerman at 2023-09-18T00:00:14-04:00 EPA: track unicode version for unrestrictedFunTyCon Closes #23885 Updates haddock submodule - - - - - 9374f116 by Andrew Lelechenko at 2023-09-18T00:00:54-04:00 Bump parsec submodule to allow text-2.1 and bytestring-0.12 - - - - - 7ca0240e by Ben Gamari at 2023-09-18T15:16:48-04:00 base: Advertise linear time of readFloat As noted in #23538, `readFloat` has runtime that scales nonlinearly in the size of its input. Consequently, its use on untrusted input can be exploited as a denial-of-service vector. Point this out and suggest use of `read` instead. See #23538. - - - - - f3f58f13 by Simon Peyton Jones at 2023-09-18T15:17:24-04:00 Remove dead code GHC.CoreToStg.Prep.canFloat This function never fires, so we can delete it: #23965. - - - - - ccab5b15 by Ben Gamari at 2023-09-18T15:18:02-04:00 base/changelog: Move fix for #23907 to 9.8.1 section Since the fix was backported to 9.8.1 - - - - - 51b57d65 by Matthew Pickering at 2023-09-19T08:44:31-04:00 Add aarch64 alpine bindist This is dynamically linked and makes creating statically linked executables more straightforward. Fixes #23482 - - - - - 02c87213 by Matthew Pickering at 2023-09-19T08:44:31-04:00 Add aarch64-deb11 bindist This adds a debian 11 release job for aarch64. Fixes #22005 - - - - - 8b61dfd6 by Alexis King at 2023-09-19T08:45:13-04:00 Don’t store the async exception masking state in CATCH frames - - - - - 86d2971e by doyougnu at 2023-09-19T19:08:19-04:00 compiler,ghci: error codes link to HF error index closes: #23259 - adds -fprint-error-index-links={auto|always|never} flag - - - - - 5f826c18 by sheaf at 2023-09-19T19:09:03-04:00 Pass quantified tyvars in tcDefaultAssocDecl This commit passes the correct set of quantified type variables written by the user in associated type default declarations for validity checking. This ensures that validity checking of associated type defaults mirrors that of standalone type family instances. Fixes #23768 (see testcase T23734 in subsequent commit) - - - - - aba18424 by sheaf at 2023-09-19T19:09:03-04:00 Avoid panic in mkGADTVars This commit avoids panicking in mkGADTVars when we encounter a type variable as in #23784 that is bound by a user-written forall but not actually used. Fixes #23784 - - - - - a525a92a by sheaf at 2023-09-19T19:09:03-04:00 Adjust reporting of unused tyvars in data FamInsts This commit adjusts the validity checking of data family instances to improve the reporting of unused type variables. See Note [Out of scope tvs in data family instances] in GHC.Tc.Validity. The problem was that, in a situation such as data family D :: Type data instance forall (d :: Type). D = MkD the RHS passed to 'checkFamPatBinders' would be the TyCon app R:D d which mentions the type variable 'd' quantified in the user-written forall. Thus, when computing the set of unused type variables in the RHS of the data family instance, we would find that 'd' is used, and report a strange error message that would say that 'd' is not bound on the LHS. To fix this, we special-case the data-family instance case, manually extracting all the type variables that appear in the arguments of all the data constructores of the data family instance. Fixes #23778 - - - - - 28dd52ee by sheaf at 2023-09-19T19:09:03-04:00 Unused tyvars in FamInst: only report user tyvars This commit changes how we perform some validity checking for coercion axioms to mirror how we handle default declarations for associated type families. This allows us to keep track of whether type variables in type and data family instances were user-written or not, in order to only report the user-written ones in "unused type variable" error messages. Consider for example: {-# LANGUAGE PolyKinds #-} type family F type instance forall a. F = () In this case, we get two quantified type variables, (k :: Type) and (a :: k); the second being user-written, but the first is introduced by the typechecker. We should only report 'a' as being unused, as the user has no idea what 'k' is. Fixes #23734 - - - - - 1eed645c by sheaf at 2023-09-19T19:09:03-04:00 Validity: refactor treatment of data families This commit refactors the reporting of unused type variables in type and data family instances to be more principled. This avoids ad-hoc logic in the treatment of data family instances. - - - - - 35bc506b by John Ericson at 2023-09-19T19:09:40-04:00 Remove `ghc-cabal` It is dead code since the Make build system was removed. I tried to go over every match of `git grep -i ghc-cabal` to find other stray bits. Some of those might be workarounds that can be further removed. - - - - - 665ca116 by John Paul Adrian Glaubitz at 2023-09-19T19:10:39-04:00 Re-add unregisterised build support for sparc and sparc64 Closes #23959 - - - - - 142f8740 by Matthew Pickering at 2023-09-19T19:11:16-04:00 Bump ci-images to use updated version of Alex Fixes #23977 - - - - - fa977034 by John Ericson at 2023-09-21T12:55:25-04:00 Use Cabal 3.10 for Hadrian We need the newer version for `CABAL_FLAG_*` env vars for #17191. - - - - - a5d22cab by John Ericson at 2023-09-21T12:55:25-04:00 hadrian: `need` any `configure` script we will call When the script is changed, we should reconfigure. - - - - - db882b57 by John Ericson at 2023-09-21T12:55:25-04:00 hadrian: Make it easier to debug Cabal configure Right now, output is squashed. This make per-package configure scripts extremely hard to maintain, because we get vague "library is missing" errors when the actually probably is usually completely unrelated except for also involving the C/C++ toolchain. (I can always pass `-VVV` to Hadrian locally, but these errors are subtle and I often cannot reproduce them locally!) `--disable-option-checking` was added back in 75c6e0684dda585c37b4ac254cd7a13537a59a91 but seems to be a bit overkill; if other flags are passed that are not recognized behind the two from Cabal mentioned in the former comment, we *do* want to know about it. - - - - - 7ed65f5a by John Ericson at 2023-09-21T12:55:25-04:00 hadrian: Increase verbosity of certain cabal commands This is a hack to get around the cabal function we're calling *decreasing* the verbosity it passes to another function, which is the stuff we often actually care about. Sigh. Keeping this a separate commit so if this makes things too verbose it is easy to revert. - - - - - a4fde569 by John Ericson at 2023-09-21T12:55:25-04:00 rts: Move most external symbols logic to the configure script This is much more terse because we are programmatically handling the leading underscore. `findPtr` however is still handled in the Cabal file because we need a newer Cabal to pass flags to the configure script automatically. Co-Authored-By: Ben Gamari <ben at well-typed.com> - - - - - 56cc85fb by Andrew Lelechenko at 2023-09-21T12:56:21-04:00 Bump Cabal submodule to allow text-2.1 and bytestring-0.12 - - - - - 0cd6148c by Matthew Pickering at 2023-09-21T12:56:21-04:00 hadrian: Generate Distribution/Fields/Lexer.x before creating a source-dist - - - - - b10ba6a3 by Andrew Lelechenko at 2023-09-21T12:56:21-04:00 Bump hadrian's index-state to upgrade alex at least to 3.2.7.3 - - - - - 11ecc37b by Luite Stegeman at 2023-09-21T12:57:03-04:00 JS: correct file size and times Programs produced by the JavaScript backend were returning incorrect file sizes and modification times, causing cabal related tests to fail. This fixes the problem and adds an additional test that verifies basic file information operations. fixes #23980 - - - - - b35fd2cd by Ben Gamari at 2023-09-21T12:57:39-04:00 gitlab-ci: Drop libiserv from upload_ghc_libs libiserv has been merged into the ghci package. - - - - - 37ad04e8 by Ben Gamari at 2023-09-21T12:58:15-04:00 testsuite: Fix Windows line endings - - - - - 5795b365 by Ben Gamari at 2023-09-21T12:58:15-04:00 testsuite: Use makefile_test - - - - - 15118740 by Ben Gamari at 2023-09-21T12:58:55-04:00 system-cxx-std-lib: Add license and description - - - - - 0208f1d5 by Ben Gamari at 2023-09-21T12:59:33-04:00 gitlab/issue-templates: Rename bug.md -> default.md So that it is visible by default. - - - - - 23cc3f21 by Andrew Lelechenko at 2023-09-21T20:18:11+01:00 Bump submodule text to 2.1 - - - - - b8e4fe23 by Andrew Lelechenko at 2023-09-22T20:05:05-04:00 Bump submodule unix to 2.8.2.1 - - - - - 54b2016e by John Ericson at 2023-09-23T11:40:41-04:00 Move lib{numa,dw} defines to RTS configure Clean up the m4 to handle the auto case always and be more consistent. Also simplify the CPP --- we should always have both headers if we are using libnuma. "side effects" (AC_DEFINE, and AC_SUBST) are removed from the macros to better separate searching from actions taken based on search results. This might seem overkill now, but will make shuffling logic between configure scripts easier later. The macro comments are converted from `dnl` to `#` following the recomendation in https://www.gnu.org/software/autoconf/manual/autoconf-2.71/html_node/Macro-Definitions.html - - - - - d51b601b by John Ericson at 2023-09-23T11:40:50-04:00 Shuffle libzstd configuring between scripts Like the prior commit for libdw and libnuma, `AC_DEFINE` to RTS configure, `AC_SUBST` goes to the top-level configure script, and the documentation of the m4 macro is improved. - - - - - d1425af0 by John Ericson at 2023-09-23T11:41:03-04:00 Move `FP_ARM_OUTLINE_ATOMICS` to RTS configure It is just `AC_DEFINE` it belongs there instead. - - - - - 18de37e4 by John Ericson at 2023-09-23T11:41:03-04:00 Move mmap in the runtime linker check to the RTS configure `AC_DEFINE` should go there instead. - - - - - 74132c2b by Andrew Lelechenko at 2023-09-25T21:56:54-04:00 Elaborate comment on GHC_NO_UNICODE - - - - - de142aa2 by Ben Gamari at 2023-09-26T15:25:03-04:00 gitlab-ci: Mark T22012 as broken on CentOS 7 Due to #23979. - - - - - 6a896ce8 by Teo Camarasu at 2023-09-26T15:25:39-04:00 hadrian: better error for failing to find file's dependencies Resolves #24004 - - - - - d697a6c2 by Stefan Holdermans at 2023-09-26T20:58:37+00:00 Refactor uses of `partitionEithers . map` This patch changes occurences of the idiom `partitionEithers (map f xs)` by the simpler form `partitionWith f xs` where `partitionWith` is the utility function defined in `GHC.Utils.Misc`. Resolves: #23953 - - - - - 8a2968b7 by Stefan Holdermans at 2023-09-26T20:58:37+00:00 Refactor uses of `partitionEithers <$> mapM f xs` This patch changes occurences of the idiom `partitionEithers <$> mapM f xs` by the simpler form `partitionWithM f xs` where `partitionWithM` is a utility function newly added to `GHC.Utils.Misc`. - - - - - 6a27eb97 by Stefan Holdermans at 2023-09-26T20:58:37+00:00 Mark `GHC.Utils.Misc.partitionWithM` as inlineable This patch adds an `INLINEABLE` pragma for `partitionWithM` to ensure that the right-hand side of the definition of this function remains available for specialisation at call sites. - - - - - f1e5245a by David Binder at 2023-09-27T01:19:00-04:00 Add RTS option to supress tix file - - - - - 1f43124f by David Binder at 2023-09-27T01:19:00-04:00 Add expected output to testsuite in test interface-stability/base-exports - - - - - b9d2c354 by David Binder at 2023-09-27T01:19:00-04:00 Expose HpcFlags and getHpcFlags from GHC.RTS.Flags - - - - - 345675c6 by David Binder at 2023-09-27T01:19:00-04:00 Fix expected output of interface-stability test - - - - - 146e1c39 by David Binder at 2023-09-27T01:19:00-04:00 Implement getHpcFlags - - - - - 61ba8e20 by David Binder at 2023-09-27T01:19:00-04:00 Add section in user guide - - - - - ea05f890 by David Binder at 2023-09-27T01:19:01-04:00 Rename --emit-tix-file to --write-tix-file - - - - - cabce2ce by David Binder at 2023-09-27T01:19:01-04:00 Update the golden files for interface stability - - - - - 1dbdb9d0 by Krzysztof Gogolewski at 2023-09-27T01:19:37-04:00 Refactor: introduce stgArgRep The function 'stgArgType' returns the type in STG. But this violates the abstraction: in STG we're supposed to operate on PrimReps. This introduces stgArgRep ty = typePrimRep (stgArgType ty) stgArgRep1 ty = typePrimRep1 (stgArgType ty) stgArgRep_maybe ty = typePrimRep_maybe (stgArgType ty) stgArgType is still directly used for unboxed tuples (should be fixable), FFI and in ticky. - - - - - b02f8042 by Mario Blažević at 2023-09-27T17:33:28-04:00 Fix TH pretty-printer's parenthesization This PR Fixes `Language.Haskell.TH.Ppr.pprint` so it correctly emits parentheses where needed. Fixes #23962, #23968, #23971, and #23986 - - - - - 79104334 by Krzysztof Gogolewski at 2023-09-27T17:34:04-04:00 Add a testcase for #17564 The code in the ticket relied on the behaviour of Derived constraints. Derived constraints were removed in GHC 9.4 and now the code works as expected. - - - - - d7a80143 by sheaf at 2023-09-28T03:25:53-04:00 lint-codes: add new modes of operation This commit adds two new modes of operation to the lint-codes utility: list - list all statically used diagnostic codes outdated - list all outdated diagnostic codes The previous behaviour is now: test - test consistency and coverage of diagnostic codes - - - - - 477d223c by sheaf at 2023-09-28T03:25:53-04:00 lint codes: avoid using git-grep We manually traverse through the filesystem to find the diagnostic codes embedded in .stdout and .stderr files, to avoid any issues with old versions of grep. Fixes #23843 - - - - - a38ae69a by sheaf at 2023-09-28T03:25:53-04:00 lint-codes: add Hadrian targets This commit adds new Hadrian targets: codes, codes:used - list all used diagnostic codes codes:outdated - list outdated diagnostic codes This allows users to easily query GHC for used and outdated diagnostic codes, e.g. hadrian/build -j --flavour=<..> codes will list all used diagnostic codes in the command line by running the lint-codes utility in the "list codes" mode of operation. The diagnostic code consistency and coverage test is still run as usual, through the testsuite: hadrian/build test --only="codes" - - - - - 9cdd629b by Ben Gamari at 2023-09-28T03:26:29-04:00 hadrian: Install LICENSE files in bindists Fixes #23548. - - - - - b8ebf876 by Matthew Craven at 2023-09-28T03:27:05-04:00 Fix visibility when eta-reducing a type lambda Fixes #24014. - - - - - d3874407 by Torsten Schmits at 2023-09-30T16:08:10-04:00 Fix several mistakes around free variables in iface breakpoints Fixes #23612 , #23607, #23998 and #23666. MR: !11026 The fingerprinting logic in `Iface.Recomp` failed lookups when processing decls containing breakpoints for two reasons: * IfaceBreakpoint created binders for free variables instead of expressions * When collecting free names for the dependency analysis for fingerprinting, breakpoint FVs were skipped - - - - - ef5342cd by Simon Peyton Jones at 2023-09-30T16:08:48-04:00 Refactor to combine HsLam and HsLamCase This MR is pure refactoring (#23916): * Combine `HsLam` and `HsLamCase` * Combine `HsCmdLam` and `HsCmdLamCase` This just arranges to treat uniformly \x -> e \case pi -> ei \cases pis -> ie In the exising code base the first is treated differently to the latter two. No change in behaviour. More specifics: * Combine `HsLam` and `HsLamCase` (constructors of `Language.Haskell.Syntax.Expr.HsExpr`) into one data construtor covering * Lambda * `\case` * `\cases` * The new `HsLam` has an argument of type `HsLamVariant` to distinguish the three cases. * Similarly, combine `HsCmdLam` and `HsCmdLamCase` (constructors of `Language.Haskell.Syntax.Expr.HsCmd` ) into one. * Similarly, combine `mkHsLamPV` and `mkHsLamCasePV` (methods of class `DisambECP`) into one. (Thank you Alan Zimmerman.) * Similarly, combine `LambdaExpr` and `LamCaseAlt` (constructors of `Language.Haskell.Syntax.Expr.HsMatchContext`) into one: `LamAlt` with a `HsLamVariant` argument. * Similarly, combine `KappaExpr` and `ArrowLamCaseAlt` (constructors of `Language.Haskell.Syntax.Expr.HsArrowMatchContext`) into one: `ArrowLamAlt` with a `HsLamVariant` argument. * Similarly, combine `PsErrLambdaInPat` and `PsErrLambdaCaseInPat` (constructors of `GHC.Parser.Errors.Ppr.PsError`) into one. * Similarly, combine `PsErrLambdaInPat` and `PsErrLambdaCaseInPat` (constructors of `GHC.Parser.Errors.Ppr.PsError`) into one. * In the same `PsError` data type, combine `PsErrLambdaCmdInFunAppCmd` and `PsErrLambdaCaseCmdInFunAppCmd` into one. * In the same `PsError` data tpye, combine `PsErrLambdaInFunAppExpr` and `PsErrLambdaCaseInFunAppExpr` into one. p* Smilarly combine `ExpectedFunTyLam` and `ExpectedFunTyLamCase` (constructors of `GHC.Tc.Types.Origin.ExpectedFunTyOrigin`) into one. Phew! - - - - - b048bea0 by Andreas Klebinger at 2023-09-30T16:09:24-04:00 Arm: Make ppr methods easier to use by not requiring NCGConfig - - - - - 2adc0508 by Andreas Klebinger at 2023-09-30T16:09:24-04:00 AArch64: Fix broken conditional jumps for offsets >= 1MB Rewrite conditional jump instructions with offsets >= 1MB to use unconditional jumps to avoid overflowing the immediate. Fixes #23746 - - - - - 1424f790 by Alan Zimmerman at 2023-09-30T16:10:00-04:00 EPA: Replace Monoid with NoAnn We currently use the Monoid class as a constraint on Exact Print Annotation functions, so we can use mempty. But this leads to requiring Semigroup instances too, which do not always make sense. Instead, introduce a class NoAnn, with a function noAnn analogous to mempty. Closes #20372 Updates haddock submodule - - - - - c1a3ecde by Ben Gamari at 2023-09-30T16:10:36-04:00 users-guide: Refactor handling of :base-ref: et al. - - - - - bc204783 by Richard Eisenberg at 2023-10-02T14:50:52+02:00 Simplify and correct nasty case in coercion opt This fixes #21062. No test case, because triggering this code seems challenging. - - - - - 9c9ca67e by Andrew Lelechenko at 2023-10-04T05:42:28-04:00 Bump bytestring submodule to 0.12.0.2 - - - - - 4e46dc2b by Andrew Lelechenko at 2023-10-04T05:42:28-04:00 Inline bucket_match - - - - - f6b2751f by Ben Gamari at 2023-10-04T05:43:05-04:00 configure: Fix #21712 again This is a bit of a shot in the dark to fix #24033, which appears to be another instance of #21712. For some reason the ld-override logic *still* appears to be active on Darwin targets (or at least one). Consequently, on misconfigured systems we may choose a non-`ld64` linker. It's a bit unclear exactly what happened in #24033 but ultimately the check added for #21712 was not quite right, checking for the `ghc_host_os` (the value of which depends upon the bootstrap compiler) instead of the target platform. Fix this. Fixes #24033. - - - - - 2f0a101d by Krzysztof Gogolewski at 2023-10-04T05:43:42-04:00 Add a regression test for #24029 - - - - - 8cee3fd7 by sheaf at 2023-10-04T05:44:22-04:00 Fix non-symbolic children lookup of fixity decl The fix for #23664 did not correctly account for non-symbolic names when looking up children of a given parent. This one-line fix changes that. Fixes #24037 - - - - - a4785b33 by Cheng Shao at 2023-10-04T05:44:59-04:00 rts: fix incorrect ticket reference - - - - - e037f459 by Ben Gamari at 2023-10-04T05:45:35-04:00 users-guide: Fix discussion of -Wpartial-fields * fix a few typos * add a new example showing when the warning fires * clarify the existing example * point out -Wincomplete-record-selects Fixes #24049. - - - - - 8ff3134e by Matthew Pickering at 2023-10-05T05:34:58-04:00 Revert "Pass preprocessor options to C compiler when building foreign C files (#16737)" This reverts commit 1c18d3b41f897f34a93669edaebe6069f319f9e2. `-optP` should pass options to the preprocessor, that might be a very different program to the C compiler, so passing the options to the C compiler is likely to result in `-optP` being useless. Fixes #17185 and #21291 - - - - - 8f6010b9 by Ben Gamari at 2023-10-05T05:35:36-04:00 rts/nonmoving: Fix on LLP64 platforms Previously `NONMOVING_SEGMENT_MASK` and friends were defined with the `UL` size suffix. However, this is wrong on LLP64 platforms like Windows, where `long` is 32-bits. Fixes #23003. Fixes #24042. - - - - - f20d02f8 by Andreas Klebinger at 2023-10-05T05:36:14-04:00 Fix isAArch64Bitmask for 32bit immediates. Fixes #23802 - - - - - 63afb701 by Bryan Richter at 2023-10-05T05:36:49-04:00 Work around perf note fetch failure Addresses #24055. - - - - - 242102f4 by Krzysztof Gogolewski at 2023-10-05T05:37:26-04:00 Add a test for #21348 - - - - - 7d390bce by Rewbert at 2023-10-05T05:38:08-04:00 Fixes #24046 - - - - - 69abb171 by Finley McIlwaine at 2023-10-06T14:06:28-07:00 Ensure unconstrained instance dictionaries get IPE info In the `StgRhsCon` case of `GHC.Stg.Debug.collectStgRhs`, we were not coming up with an initial source span based on the span of the binder, which was causing instance dictionaries without dynamic superclass constraints to not have source locations in their IPE info. Now they do. Resolves #24005 - - - - - 390443b7 by Andreas Klebinger at 2023-10-07T10:00:20-04:00 rts: Split up rts/include/stg/MachRegs.h by arch - - - - - 3685942f by Bryan Richter at 2023-10-07T10:00:56-04:00 Actually set hackage index state Or at least, use a version of the cabal command that *claims* to set the index state. Time will tell. - - - - - 46a0e5be by Bryan Richter at 2023-10-07T10:00:56-04:00 Update hackage index state - - - - - d4b037de by Bryan Richter at 2023-10-07T10:00:56-04:00 Ensure hadrian uses CI's hackage index state - - - - - e206be64 by Andrew Lelechenko at 2023-10-08T15:06:14-04:00 Do not use O_NONBLOCK on regular files or block devices CLC proposal https://github.com/haskell/core-libraries-committee/issues/166 - - - - - a06197c4 by David Binder at 2023-10-08T15:06:55-04:00 Update hpc-bin submodule to 0.69 - - - - - ed6785b6 by David Binder at 2023-10-08T15:06:55-04:00 Update Hadrian with correct path to happy file for hpc-bin - - - - - 94066d58 by Alan Zimmerman at 2023-10-09T21:35:53-04:00 EPA: Introduce HasAnnotation class The class is defined as class HasAnnotation e where noAnnSrcSpan :: SrcSpan -> e This generalises noAnnSrcSpan, and allows noLocA :: (HasAnnotation e) => a -> GenLocated e a noLocA = L (noAnnSrcSpan noSrcSpan) - - - - - 8792a1bc by Ben Gamari at 2023-10-09T21:36:29-04:00 Bump unix submodule to v2.8.3.0 - - - - - e96c51cb by Andreas Klebinger at 2023-10-10T16:44:27+01:00 Add a flag -fkeep-auto-rules to optionally keep auto-generated rules around. The motivation for the flag is given in #21917. - - - - - 3ed58cef by Matthew Pickering at 2023-10-10T19:01:22-04:00 hadrian: Add ghcToolchain to tool args list This allows you to load ghc-toolchain and ghc-toolchain-bin into HLS. - - - - - 476c02d4 by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Normalise triple via config.sub We were not normalising the target triple anymore like we did with the old make build system. Fixes #23856 - - - - - 303dd237 by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Add missing vendor normalisation This is copied from m4/ghc_convert_vendor.m4 Towards #23868 - - - - - 838026c9 by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Add loongarch64 to parseArch Towards #23868 - - - - - 1a5bc0b5 by Matthew Pickering at 2023-10-10T19:01:22-04:00 Add same LD hack to ghc-toolchain In the ./configure script, if you pass the `LD` variable then this has the effect of stopping use searching for a linker and hence passing `-fuse-ld=...`. We want to emulate this logic in ghc-toolchain, if a use explicilty specifies `LD` variable then don't add `-fuse-ld=..` with the goal of making ./configure and ghc-toolchain agree on which flags to use when using the C compiler as a linker. This is quite unsavoury as we don't bake the choice of LD into the configuration anywhere but what's important for now is making ghc-toolchain and ./configure agree as much as possible. See #23857 for more discussion - - - - - 42d50b5a by Ben Gamari at 2023-10-10T19:01:22-04:00 ghc-toolchain: Check for C99 support with -std=c99 Previously we failed to try enabling C99 support with `-std=c99`, as `autoconf` attempts. This broke on older compilers (e.g. CentOS 7) which don't enable C99 by default. Fixes #23879. - - - - - da2961af by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Add endianess check using __BYTE_ORDER__ macro In very old toolchains the BYTE_ORDER macro is not set but thankfully the __BYTE_ORDER__ macro can be used instead. - - - - - d8da73cd by Matthew Pickering at 2023-10-10T19:01:22-04:00 configure: AC_PATH_TARGET_TOOL for LD We want to make sure that LD is set to an absolute path in order to be consistent with the `LD=$(command -v ld)` call. The AC_PATH_TARGET_TOOL macro uses the absolute path rather than AC_CHECK_TARGET_TOOL which might use a relative path. - - - - - 171f93cc by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Check whether we need -std=gnu99 for CPP as well In ./configure the C99 flag is passed to the C compiler when used as a C preprocessor. So we also check the same thing in ghc-toolchain. - - - - - 89a0918d by Matthew Pickering at 2023-10-10T19:01:22-04:00 Check for --target linker flag separately to C compiler There are situations where the C compiler doesn't accept `--target` but when used as a linker it does (but doesn't do anything most likely) In particular with old gcc toolchains, the C compiler doesn't support --target but when used as a linker it does. - - - - - 37218329 by Matthew Pickering at 2023-10-10T19:01:22-04:00 Use Cc to compile test file in nopie check We were attempting to use the C compiler, as a linker, to compile a file in the nopie check, but that won't work in general as the flags we pass to the linker might not be compatible with the ones we pass when using the C compiler. - - - - - 9b2dfd21 by Matthew Pickering at 2023-10-10T19:01:22-04:00 configure: Error when ghc-toolchain fails to compile This is a small QOL change as if you are working on ghc-toolchain and it fails to compile then configure will continue and can give you outdated results. - - - - - 1f0de49a by Matthew Pickering at 2023-10-10T19:01:22-04:00 configure: Check whether -no-pie works when the C compiler is used as a linker `-no-pie` is a flag we pass when using the C compiler as a linker (see pieCCLDOpts in GHC.Driver.Session) so we should test whether the C compiler used as a linker supports the flag, rather than just the C compiler. - - - - - 62cd2579 by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Remove javascript special case for --target detection emcc when used as a linker seems to ignore the --target flag, and for consistency with configure which now tests for --target, we remove this special case. - - - - - 0720fde7 by Ben Gamari at 2023-10-10T19:01:22-04:00 toolchain: Don't pass --target to emscripten toolchain As noted in `Note [Don't pass --target to emscripten toolchain]`, emscripten's `emcc` is rather inconsistent with respect to its treatment of the `--target` flag. Avoid this by special-casing this toolchain in the `configure` script and `ghc-toolchain`. Fixes on aspect of #23744. - - - - - 6354e1da by Matthew Pickering at 2023-10-10T19:01:22-04:00 hadrian: Don't pass `--gcc-options` as a --configure-arg to cabal configure Stop passing -gcc-options which mixed together linker flags and non-linker flags. There's no guarantee the C compiler will accept both of these in each mode. - - - - - c00a4bd6 by Ben Gamari at 2023-10-10T19:01:22-04:00 configure: Probe stage0 link flags For consistency with later stages and CC. - - - - - 1f11e7c4 by Sebastian Graf at 2023-10-10T19:01:58-04:00 Stricter Binary.get in GHC.Types.Unit (#23964) I noticed some thunking while looking at Core. This change has very modest, but throughout positive ghc/alloc effect: ``` hard_hole_fits(normal) ghc/alloc 283,057,664 281,620,872 -0.5% geo. mean -0.1% minimum -0.5% maximum +0.0% ``` Fixes #23964. - - - - - a4f1a181 by Bryan Richter at 2023-10-10T19:02:37-04:00 rel_eng/upload.sh cleanups - - - - - 80705335 by doyougnu at 2023-10-10T19:03:18-04:00 ci: add javascript label rule This adds a rule which triggers the javascript job when the "javascript" label is assigned to an MR. - - - - - a2c0fff6 by Matthew Craven at 2023-10-10T19:03:54-04:00 Make 'wWarningFlagsDeps' include every WarningFlag Fixes #24071. - - - - - d055f099 by Jan Hrček at 2023-10-10T19:04:33-04:00 Fix pretty printing of overlap pragmas in TH splices (fixes #24074) - - - - - 0746b868 by Andreas Klebinger at 2023-10-10T19:05:09-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - 739f4e6f by Andreas Klebinger at 2023-10-10T19:05:09-04:00 AArch NCG: Refactor getRegister' Remove some special cases which can be handled just as well by the generic case. This increases code re-use while also fixing #23749. Since some of the special case wasn't upholding Note [Signed arithmetic on AArch64]. - - - - - 1b213d33 by Andreas Klebinger at 2023-10-10T19:05:09-04:00 Aarch ncg: Optimize immediate use for address calculations When the offset doesn't fit into the immediate we now just reuse the general getRegister' code path which is well optimized to compute the offset into a register instead of a special case for CmmRegOff. This means we generate a lot less code under certain conditions which is why performance metrics for these improve. ------------------------- Metric Decrease: T4801 T5321FD T5321Fun ------------------------- - - - - - b7df0732 by John Ericson at 2023-10-11T16:02:11-04:00 RTS configure: Move over mem management checks These are for heap allocation, a strictly RTS concern. All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. The RTS configure one has a new ``` AC_CHECK_SIZEOF([void *]) ``` that the top-level configure version didn't have, so that `ac_cv_sizeof_void_p` is defined. Once more code is moved over in latter commits, that can go away. Progress towards #17191 - - - - - 41130a65 by John Ericson at 2023-10-11T16:02:11-04:00 RTS configure: Move over `__thread` check This used by (@bgamari thinks) the `GCThread` abstraction in the RTS. All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. Progress towards #17191 - - - - - cc5ec2bd by John Ericson at 2023-10-11T16:02:11-04:00 RTS configure: Move over misc function checks These are for general use in the RTS. All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. Progress towards #17191 - - - - - 809e7c2d by John Ericson at 2023-10-11T16:02:11-04:00 RTS configure: Move over `eventfd` check This check is for the RTS part of the event manager and has a corresponding part in `base`. All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. Progress towards #17191 - - - - - 58f3babf by John Ericson at 2023-10-11T16:02:48-04:00 Split `FP_CHECK_PTHREADS` and move part to RTS configure `NEED_PTHREAD_LIB` is unused since 3609340743c1b25fdfd0e18b1670dac54c8d8623 (part of the make build system), and so is no longer defined. Progress towards #17191 - - - - - e99cf237 by Moritz Angermann at 2023-10-11T16:03:24-04:00 nativeGen: section flags for .text$foo only Commit 3ece9856d157c85511d59f9f862ab351bbd9b38b, was supposed to fix #22834 in !9810. It does however add "xr" indiscriminatly to .text sections even if splitSections is disabled. This leads to the assembler saying: ghc_1.s:7849:0: error: Warning: Ignoring changed section attributes for .text | 7849 | .section .text,"xr" | ^ - - - - - f383a242 by Sylvain Henry at 2023-10-11T16:04:04-04:00 Modularity: pass TempDir instead of DynFlags (#17957) - - - - - 34fc28b0 by John Ericson at 2023-10-12T06:48:28-04:00 Test that functions from `mingwex` are available Ryan wrote these two minimizations, but they never got added to the test suite. See #23309, #23378 Co-Authored-By: Ben Gamari <bgamari.foss at gmail.com> Co-Authored-By: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - bdb54a0e by John Ericson at 2023-10-12T06:48:28-04:00 Do not check for the `mingwex` library in `/configure` See the recent discussion in !10360 --- Cabal will itself check for the library for the packages that need it, and while the autoconf check additionally does some other things like define a `HAS_LIBMINGWEX` C Preprocessor macro, those other things are also unused and unneeded. Progress towards #17191, which aims to get rid of `/configure` entirely. - - - - - 43e814e1 by Ben Gamari at 2023-10-12T06:49:40-04:00 base: Introduce move modules into src The only non-move changes here are whitespace changes to pass the `whitespace` test and a few testsuite adaptations. - - - - - df81536f by Moritz Angermann at 2023-10-12T06:50:16-04:00 [PEi386 linker] Bounds check and null-deref guard We should resonably be able to expect that we won't exceed the number of sections if we assume to be dealing with legal object files. We can however not guarantee that we get some negative values, and while we try to special case most, we should exclude negative indexing into the sections array. We also need to ensure that we do not try to derefences targetSection, if it is NULL, due to the switch statement. - - - - - c74c4f00 by John Ericson at 2023-10-12T10:31:13-04:00 Move apple compat check to RTS configure - - - - - c80778ea by John Ericson at 2023-10-12T10:31:13-04:00 Move clock/timer fun checks to RTS configure Actual library check (which will set the Cabal flag) is left in the top-level configure for now. Progress towards #17191 - - - - - 7f9f2686 by John Ericson at 2023-10-12T10:31:13-04:00 Move visibility and "musttail" annotation checks to the RTS configure All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. Progress towards #17191 - - - - - ffb3efe6 by John Ericson at 2023-10-12T10:31:13-04:00 Move leading underscore checks to RTS configure `CabalLeadingUnderscore` is done via Hadrian already, so we can stop `AC_SUBST`ing it completely. - - - - - 25fa4b02 by John Ericson at 2023-10-12T10:31:13-04:00 Move alloca, fork, const, and big endian checks to RTS configure All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. - - - - - 5170f42a by John Ericson at 2023-10-12T10:31:13-04:00 Move libdl check to RTS configure - - - - - ea7a1447 by John Ericson at 2023-10-12T10:31:13-04:00 Adjust `FP_FIND_LIBFFI` Just set vars, and `AC_SUBST` in top-level configure. Don't define `HAVE_SYSTEM_LIBFFI` because nothing is using it. It hasn't be in used since 3609340743c1b25fdfd0e18b1670dac54c8d8623 (part of the make build system). - - - - - f399812c by John Ericson at 2023-10-12T10:31:13-04:00 Split BFD support to RTS configure The flag is still in the top-level configure, but the other checks (which define various macros --- important) are in the RTS configure. - - - - - f64f44e9 by John Ericson at 2023-10-12T10:31:13-04:00 Split libm check between top level and RTS - - - - - dafc4709 by Moritz Angermann at 2023-10-12T10:31:49-04:00 CgUtils.fixStgRegStmt respect register width This change ensure that the reg + offset computation is always of the same size. Before this we could end up with a 64bit register, and then add a 32bit offset (on 32bit platforms). This not only would fail type sanity checking, but also incorrectly truncate 64bit values into 32bit values silently on 32bit architectures. - - - - - 9e6ef7ba by Matthew Pickering at 2023-10-12T20:35:00-04:00 hadrian: Decrease verbosity of cabal commands In Normal, most tools do not produce output to stdout unless there are error conditions. Reverts 7ed65f5a1bc8e040e318ccff395f53a9bbfd8217 - - - - - 08fc27af by John Ericson at 2023-10-12T20:35:36-04:00 Do not substitute `@...@` for stage-specific values in cabal files `rts` and `ghc-prim` now no longer have a `*.cabal.in` to set Cabal flag defaults; instead manual choices are passed to configure in the usual way. The old way was fundamentally broken, because it meant we were baking these Cabal files for a specific stage. Now we only do stage-agnostic @...@ substitution in cabal files (the GHC version), and so all stage-specific configuration is properly confined to `_build` and the right stage dir. Also `include-ghc-prim` is a flag that no longer exists for `ghc-prim` (it was removed in 835d8ddbbfb11796ea8a03d1806b7cee38ba17a6) so I got rid of it. Co-Authored-By: Matthew Pickering <matthewtpickering at gmail.com> - - - - - a0ac8785 by Sebastian Graf at 2023-10-14T19:17:12-04:00 Fix restarts in .ghcid Using the whole of `hadrian/` restarted in a loop for me. - - - - - fea9ecdb by Sebastian Graf at 2023-10-14T19:17:12-04:00 CorePrep: Refactor FloatingBind (#23442) A drastically improved architecture for local floating in CorePrep that decouples the decision of whether a float is going to be let- or case-bound from how far it can float (out of strict contexts, out of lazy contexts, to top-level). There are a couple of new Notes describing the effort: * `Note [Floating in CorePrep]` for the overview * `Note [BindInfo and FloatInfo]` for the new classification of floats * `Note [Floats and FloatDecision]` for how FloatInfo is used to inform floating decisions This is necessary ground work for proper treatment of Strict fields and unlifted values at top-level. Fixes #23442. NoFib results (omitted = 0.0%): ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- pretty 0.0% -1.6% scc 0.0% -1.7% -------------------------------------------------------------------------------- Min 0.0% -1.7% Max 0.0% -0.0% Geometric Mean -0.0% -0.0% ``` - - - - - 32523713 by Matthew Pickering at 2023-10-14T19:17:49-04:00 hadrian: Move ghcBinDeps into ghcLibDeps This completes a5227080b57cb51ac34d4c9de1accdf6360b818b, the `ghc-usage.txt` and `ghci-usage.txt` file are also used by the `ghc` library so need to make sure they are present in the libdir even if we are not going to build `ghc-bin`. This also fixes things for cross compilers because the stage2 cross-compiler requires the ghc-usage.txt file, but we are using the stage2 lib folder but not building stage3:exe:ghc-bin so ghc-usage.txt was not being generated. - - - - - ec3c4488 by sheaf at 2023-10-14T19:18:29-04:00 Combine GREs when combining in mkImportOccEnv In `GHC.Rename.Names.mkImportOccEnv`, we sometimes discard one import item in favour of another, as explained in Note [Dealing with imports] in `GHC.Rename.Names`. However, this can cause us to lose track of important parent information. Consider for example #24084: module M1 where { class C a where { type T a } } module M2 ( module M1 ) where { import M1 } module M3 where { import M2 ( C, T ); instance C () where T () = () } When processing the import list of `M3`, we start off (for reasons that are not relevant right now) with two `Avail`s attached to `T`, namely `C(C, T)` and `T(T)`. We combine them in the `combine` function of `mkImportOccEnv`; as described in Note [Dealing with imports] we discard `C(C, T)` in favour of `T(T)`. However, in doing so, we **must not** discard the information want that `C` is the parent of `T`. Indeed, losing track of this information can cause errors when importing, as we could get an error of the form ‘T’ is not a (visible) associated type of class ‘C’ We fix this by combining the two GREs for `T` using `plusGRE`. Fixes #24084 - - - - - 257c2807 by Ilias Tsitsimpis at 2023-10-14T19:19:07-04:00 hadrian: Pass -DNOSMP to C compiler when needed Hadrian passes the -DNOSMP flag to GHC when the target doesn't support SMP, but doesn't pass it to CC as well, leading to the following compilation error on mips64el: | Run Cc (FindCDependencies CDep) Stage1: rts/sm/NonMovingScav.c => _build/stage1/rts/build/c/sm/NonMovingScav.o.d Command line: /usr/bin/mips64el-linux-gnuabi64-gcc -E -MM -MG -MF _build/stage1/rts/build/c/hooks/FlagDefaults.thr_debug_p_o.d -MT _build/stage1/rts/build/c/hooks/FlagDefaults.o -Irts/include -I_build/stage1/rts/build -I_build/stage1/rts/build/include -Irts/include -x c rts/hooks/FlagDefaults.c -Wall -Wextra -Wstrict-prototypes -Wmissing-prototypes -Wmissing-declarations -Winline -Wpointer-arith -Wmissing-noreturn -Wnested-externs -Wredundant-decls -Wundef -fno-strict-aliasing -DTHREADED_RTS -DDEBUG -fomit-frame-pointer -O2 -g -Irts -I_build/stage1/rts/build -DDEBUG -fno-omit-frame-pointer -g3 -O0 ===> Command failed with error code: 1 In file included from rts/include/Stg.h:348, from rts/include/Rts.h:38, from rts/hooks/FlagDefaults.c:8: rts/include/stg/SMP.h:416:2: error: #error memory barriers unimplemented on this architecture 416 | #error memory barriers unimplemented on this architecture | ^~~~~ rts/include/stg/SMP.h:440:2: error: #error memory barriers unimplemented on this architecture 440 | #error memory barriers unimplemented on this architecture | ^~~~~ rts/include/stg/SMP.h:464:2: error: #error memory barriers unimplemented on this architecture 464 | #error memory barriers unimplemented on this architecture | ^~~~~ The old make system correctly passed this flag to both GHC and CC [1]. Fix this error by passing -DNOSMP to CC as well. [1] https://gitlab.haskell.org/ghc/ghc/-/blob/00920f176b0235d5bb52a8e054d89a664f8938fe/rts/ghc.mk#L407 Closes #24082 - - - - - 13d3c613 by John Ericson at 2023-10-14T19:19:42-04:00 Users Guide: Drop dead code for Haddock refs to `parallel` I noticed while working on !11451 that `@LIBRARY_parallel_UNIT_ID@` was not substituted. It is dead code -- there is no `parallel-ref` usages and it doesn't look like there ever was (going back to 3e5d0f188d6c8633e55e9ba6c8941c07e459fa4b), so let's delete it. - - - - - fe067577 by Sylvain Henry at 2023-10-18T19:40:25-04:00 Avoid out-of-bound array access in bigNatIsPowerOf2 (fix #24066) bigNatIndex# in the `where` clause wasn't guarded by "bigNatIsZero a". - - - - - cc1625b1 by Sylvain Henry at 2023-10-18T19:40:25-04:00 Bignum: fix right shift of negative BigNat with native backend - - - - - cbe4400d by Sylvain Henry at 2023-10-18T19:40:25-04:00 Rts: expose rtsOutOfBoundsAccess symbol - - - - - 72c7380c by Sylvain Henry at 2023-10-18T19:40:25-04:00 Hadrian: enable `-fcheck-prim-bounds` in validate flavour This allows T24066 to fail when the bug is present. Otherwise the out-of-bound access isn't detected as it happens in ghc-bignum which wasn't compiled with the bounds check. - - - - - f9436990 by John Ericson at 2023-10-18T19:41:01-04:00 Make Hadrian solely responsible for substituting `docs/users_guide/ghc_config.py.in` Fixes #24091 Progress on #23966 Issue #24091 reports that `@ProjectVersion@` is no longer being substituted in the GHC user's guide. I assume this is a recent issue, but I am not sure how it's worked since c1a3ecde720b3bddc2c8616daaa06ee324e602ab; it looks like both Hadrian and configure are trying to substitute the same `.in` file! Now only Hadrian does. That is better anyways; already something that issue #23966 requested. It seems like we were missing some dependencies in Hadrian. (I really, really hate that this is possible!) Hopefully it is fixed now. - - - - - b12df0bb by John Ericson at 2023-10-18T19:41:37-04:00 `ghcversion.h`: No need to cope with undefined `ProjectPatchLevel*` Since 4e6c80197f1cc46dfdef0300de46847c7cfbdcb0, these are guaranteed to be defined. (Guaranteed including a test in the testsuite.) - - - - - 0295375a by John Ericson at 2023-10-18T19:41:37-04:00 Generate `ghcversion.h` from a `.in` file Now that there are no conditional sections (see the previous commit), we can just a do simple substitution rather than pasting it together line by line. Progress on #23966 - - - - - 740a1b85 by Krzysztof Gogolewski at 2023-10-19T11:37:20-04:00 Add a regression test for #24064 - - - - - 921fbf2f by Hécate Moonlight at 2023-10-19T11:37:59-04:00 CLC Proposal #182: Export List from Data.List Proposal link: https://github.com/haskell/core-libraries-committee/issues/182 - - - - - 4f02d3c1 by Sylvain Henry at 2023-10-20T04:01:32-04:00 rts: fix small argument passing on big-endian arch (fix #23387) - - - - - b86243b4 by Sylvain Henry at 2023-10-20T04:02:13-04:00 Interpreter: fix literal alignment on big-endian architectures (fix #19261) Literals weren't correctly aligned on big-endian, despite what the comment said. - - - - - a4b2ec47 by Sylvain Henry at 2023-10-20T04:02:54-04:00 Testsuite: recomp011 and recomp015 are fixed on powerpc These tests have been fixed but not tested and re-enabled on big-endian powerpc (see comments in #11260 and #11323) - - - - - fded7dd4 by Sebastian Graf at 2023-10-20T04:03:30-04:00 CorePrep: Allow floating dictionary applications in -O0 into a Rec (#24102) - - - - - 02efc181 by John Ericson at 2023-10-22T02:48:55-04:00 Move function checks to RTS configure Some of these functions are used in `base` too, but we can copy the checks over to its configure if that's an issue. - - - - - 5f4bccab by John Ericson at 2023-10-22T02:48:55-04:00 Move over a number of C-style checks to RTS configure - - - - - 5cf04f58 by John Ericson at 2023-10-22T02:48:55-04:00 Move/Copy more `AC_DEFINE` to RTS config Only exception is the LLVM version macros, which are used for GHC itself. - - - - - b8ce5dfe by John Ericson at 2023-10-22T02:48:55-04:00 Define `TABLES_NEXT_TO_CODE` in the RTS configure We create a new cabal flag to facilitate this. - - - - - 4a40271e by John Ericson at 2023-10-22T02:48:55-04:00 Configure scripts: `checkOS`: Make a bit more robust `mingw64` and `mingw32` are now both accepted for `OSMinGW32`. This allows us to cope with configs/triples that we haven't normalized extra being what GNU `config.sub` does. - - - - - 16bec0a0 by John Ericson at 2023-10-22T02:48:55-04:00 Generate `ghcplatform.h` from RTS configure We create a new cabal flag to facilitate this. - - - - - 7dfcab2f by John Ericson at 2023-10-22T02:48:55-04:00 Get rid of all mention of `mk/config.h` The RTS configure script is now solely responsible for managing its headers; the top level configure script does not help. - - - - - c1e3719c by Cheng Shao at 2023-10-22T02:49:33-04:00 rts: drop stale mentions of MIN_UPD_SIZE We used to have MIN_UPD_SIZE macro that describes the minimum reserved size for thunks, so that the thunk can be overwritten in place as indirections or blackholes. However, this macro has not been actually defined or used anywhere since a long time ago; StgThunkHeader already reserves a padding word for this purpose. Hence this patch which drops stale mentions of MIN_UPD_SIZE. - - - - - d24b0d85 by Andrew Lelechenko at 2023-10-22T02:50:11-04:00 base changelog: move non-backported entries from 4.19 section to 4.20 Neither !10933 (check https://hackage.haskell.org/package/base-4.19.0.0/docs/src/Text.Read.Lex.html#numberToRangedRational) nor !10189 (check https://hackage.haskell.org/package/base-4.19.0.0/docs/src/Data.List.NonEmpty.html#unzip) were backported to `base-4.19.0.0`. Moving them to `base-4.20.0.0` section. Also minor stylistic changes to other entries, bringing them to a uniform form. - - - - - de78b32a by Alan Zimmerman at 2023-10-23T09:09:41-04:00 EPA Some tweaks to annotations - Fix span for GRHS - Move TrailingAnns from last match to FunBind - Fix GADT 'where' clause span - Capture full range for a CaseAlt Match - - - - - d5a8780d by Simon Hengel at 2023-10-23T09:10:23-04:00 Update primitives.rst - - - - - 4d075924 by Josh Meredith at 2023-10-24T23:04:12+11:00 JS/userguide: add explanation of writing jsbits - - - - - 07ab5cc1 by Cheng Shao at 2023-10-24T15:40:32-04:00 testsuite: increase timeout of ghc-api tests for wasm32 ghc-api tests for wasm32 are more likely to timeout due to the large wasm module sizes, especially when testing with wasm native tail calls, given wasmtime's handling of tail call opcodes are suboptimal at the moment. It makes sense to increase timeout specifically for these tests on wasm32. This doesn't affect other targets, and for wasm32 we don't increase timeout for all tests, so not to risk letting major performance regressions slip through the testsuite. - - - - - 0d6acca5 by Greg Steuck at 2023-10-26T08:44:23-04:00 Explicitly require RLIMIT_AS before use in OSMem.c This is done elsewhere in the source tree. It also suddenly is required on OpenBSD. - - - - - 9408b086 by Sylvain Henry at 2023-10-26T08:45:03-04:00 Modularity: modularize external linker Decouple runLink from DynFlags to allow calling runLink more easily. This is preliminary work for calling Emscripten's linker (emcc) from our JavaScript linker. - - - - - e0f35030 by doyougnu at 2023-10-27T08:41:12-04:00 js: add JStg IR, remove unsaturated constructor - Major step towards #22736 and adding the optimizer in #22261 - - - - - 35587eba by Simon Peyton Jones at 2023-10-27T08:41:48-04:00 Fix a bug in tail calls with ticks See #24078 for the diagnosis. The change affects only the Tick case of occurrence analysis. It's a bit hard to test, so no regression test (yet anyway). - - - - - 9bc5cb92 by Matthew Craven at 2023-10-28T07:06:17-04:00 Teach tag-inference about SeqOp/seq# Fixes the STG/tag-inference analogue of #15226. Co-Authored-By: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 34f06334 by Moritz Angermann at 2023-10-28T07:06:53-04:00 [PEi386] Mask SYM_TYPE_DUP_DISCARD in makeSymbolExtra 48e391952c17ff7eab10b0b1456e3f2a2af28a9b introduced `SYM_TYPE_DUP_DISCARD` to the bitfield. The linker however, failed to mask the `SYM_TYPE_DUP_DISCARD` value. Thus `== SYM_TYPE_CODE` comparisons easily failed. This lead to us relocating DATA lookups (GOT) into E8 (call) and E9 (jump) instructions. - - - - - 5b51b2a2 by Mario Blažević at 2023-10-28T07:07:33-04:00 Fix and test for issue #24111, TH.Ppr output of pattern synonyms - - - - - 723bc352 by Alan Zimmerman at 2023-10-30T20:36:41-04:00 EPA: print doc comments as normal comments And ignore the ones allocated in haddock processing. It does not guarantee that every original haddock-like comment appears in the output, as it discards ones that have no legal attachment point. closes #23459 - - - - - 21b76843 by Simon Peyton Jones at 2023-10-30T20:37:17-04:00 Fix non-termination bug in equality solver constraint left-to-right then right to left, forever. Easily fixed. - - - - - 270867ac by Sebastian Graf at 2023-10-30T20:37:52-04:00 ghc-toolchain: build with `-package-env=-` (#24131) Otherwise globally installed libraries (via `cabal install --lib`) break the build. Fixes #24131. - - - - - 7a90020f by Krzysztof Gogolewski at 2023-10-31T20:03:37-04:00 docs: fix ScopedTypeVariables example (#24101) The previous example didn't compile. Furthermore, it wasn't demonstrating the point properly. I have changed it to an example which shows that 'a' in the signature must be the same 'a' as in the instance head. - - - - - 49f69f50 by Krzysztof Gogolewski at 2023-10-31T20:04:13-04:00 Fix pretty-printing of type family dependencies "where" should be after the injectivity annotation. - - - - - 73c191c0 by Ben Gamari at 2023-10-31T20:04:49-04:00 gitlab-ci: Bump LLVM bootstrap jobs to Debian 12 As the Debian 10 images have too old an LLVM. Addresses #24056. - - - - - 5b0392e0 by Matthew Pickering at 2023-10-31T20:04:49-04:00 ci: Run aarch64 llvm backend job with "LLVM backend" label This brings it into line with the x86 LLVM backend job. - - - - - 9f9c9227 by Ryan Scott at 2023-11-01T09:19:12-04:00 More robust checking for DataKinds As observed in #22141, GHC was not doing its due diligence in catching code that should require `DataKinds` in order to use. Most notably, it was allowing the use of arbitrary data types in kind contexts without `DataKinds`, e.g., ```hs data Vector :: Nat -> Type -> Type where ``` This patch revamps how GHC tracks `DataKinds`. The full specification is written out in the `DataKinds` section of the GHC User's Guide, and the implementation thereof is described in `Note [Checking for DataKinds]` in `GHC.Tc.Validity`. In brief: * We catch _type_-level `DataKinds` violations in the renamer. See `checkDataKinds` in `GHC.Rename.HsType` and `check_data_kinds` in `GHC.Rename.Pat`. * We catch _kind_-level `DataKinds` violations in the typechecker, as this allows us to catch things that appear beneath type synonyms. (We do *not* want to do this in type-level contexts, as it is perfectly fine for a type synonym to mention something that requires DataKinds while still using the type synonym in a module that doesn't enable DataKinds.) See `checkValidType` in `GHC.Tc.Validity`. * There is now a single `TcRnDataKindsError` that classifies all manner of `DataKinds` violations, both in the renamer and the typechecker. The `NoDataKindsDC` error has been removed, as it has been subsumed by `TcRnDataKindsError`. * I have added `CONSTRAINT` is `isKindTyCon`, which is what checks for illicit uses of data types at the kind level without `DataKinds`. Previously, `isKindTyCon` checked for `Constraint` but not `CONSTRAINT`. This is inconsistent, given that both `Type` and `TYPE` were checked by `isKindTyCon`. Moreover, it thwarted the implementation of the `DataKinds` check in `checkValidType`, since we would expand `Constraint` (which was OK without `DataKinds`) to `CONSTRAINT` (which was _not_ OK without `DataKinds`) and reject it. Now both are allowed. * I have added a flurry of additional test cases that test various corners of `DataKinds` checking. Fixes #22141. - - - - - 575d7690 by Sylvain Henry at 2023-11-01T09:19:53-04:00 JS: fix FFI "wrapper" and "dynamic" Fix codegen and helper functions for "wrapper" and "dynamic" foreign imports. Fix tests: - ffi006 - ffi011 - T2469 - T4038 Related to #22363 - - - - - 81fb8885 by Alan Zimmerman at 2023-11-01T22:23:56-04:00 EPA: Use full range for Anchor This change requires a series of related changes, which must all land at the same time, otherwise all the EPA tests break. * Use the current Anchor end as prior end Use the original anchor location end as the source of truth for calculating print deltas. This allows original spacing to apply in most cases, only changed AST items need initial delta positions. * Add DArrow to TrailingAnn * EPA Introduce HasTrailing in ExactPrint Use [TrailingAnn] in enterAnn and remove it from ExactPrint (LocatedN RdrName) * In HsDo, put TrailingAnns at top of LastStmt * EPA: do not convert comments to deltas when balancing. * EPA: deal with fallout from getMonoBind * EPA fix captureLineSpacing * EPA print any comments in the span before exiting it * EPA: Add comments to AnchorOperation * EPA: remove AnnEofComment, it is no longer used Updates Haddock submodule - - - - - 03e82511 by Rodrigo Mesquita at 2023-11-01T22:24:32-04:00 Fix in docs regarding SSymbol, SNat, SChar (#24119) - - - - - 362cc693 by Matthew Pickering at 2023-11-01T22:25:08-04:00 hadrian: Update bootstrap plans (9.4.6, 9.4.7, 9.6.2, 9.6.3, 9.8.1) Updating the bootstrap plans with more recent GHC versions. - - - - - 00b9b8d3 by Matthew Pickering at 2023-11-01T22:25:08-04:00 ci: Add 9.8.1 bootstrap testing job - - - - - ef3d20f8 by Matthew Pickering at 2023-11-01T22:25:08-04:00 Compatibility with 9.8.1 as boot compiler This fixes several compatability issues when using 9.8.1 as the boot compiler. * An incorrect version guard on the stack decoding logic in ghc-heap * Some ghc-prim bounds need relaxing * ghc is no longer wired in, so we have to remove the -this-unit-id ghc call. Fixes #24077 - - - - - 6755d833 by Jaro Reinders at 2023-11-03T10:54:42+01:00 Add NCG support for common 64bit operations to the x86 backend. These used to be implemented via C calls which was obviously quite bad for performance for operations like simple addition. Co-authored-by: Andreas Klebinger - - - - - 0dfb1fa7 by Vladislav Zavialov at 2023-11-03T14:08:41-04:00 T2T in Expressions (#23738) This patch implements the T2T (term-to-type) transformation in expressions. Given a function with a required type argument vfun :: forall a -> ... the user can now call it as vfun (Maybe Int) instead of vfun (type (Maybe Int)) The Maybe Int argument is parsed and renamed as a term (HsExpr), but then undergoes a conversion to a type (HsType). See the new function expr_to_type in compiler/GHC/Tc/Gen/App.hs and Note [RequiredTypeArguments and the T2T mapping] Left as future work: checking for puns. - - - - - cc1c7c54 by Duncan Coutts at 2023-11-05T00:23:44-04:00 Add a test for I/O managers It tries to cover the cases of multiple threads waiting on the same fd for reading and multiple threads waiting for writing, including wait cancellation by async exceptions. It should work for any I/O manager, in-RTS or in-Haskell. Unfortunately it will not currently work for Windows because it relies on anonymous unix sockets. It could in principle be ported to use Windows named pipes. - - - - - 2e448f98 by Cheng Shao at 2023-11-05T00:23:44-04:00 Skip the IOManager test on wasm32 arch. The test relies on the sockets API which are not (yet) available. - - - - - fe50eb35 by Cheng Shao at 2023-11-05T00:24:20-04:00 compiler: fix eager blackhole symbol in wasm32 NCG - - - - - af771148 by Cheng Shao at 2023-11-05T00:24:20-04:00 testsuite: fix optasm tests for wasm32 - - - - - 1b90735c by Matthew Pickering at 2023-11-05T00:24:20-04:00 testsuite: Add wasm32 to testsuite arches with NCG The compiler --info reports that wasm32 compilers have a NCG, so we should agree with that here. - - - - - db9a6496 by Alan Zimmerman at 2023-11-05T00:24:55-04:00 EPA: make locA a function, not a field name And use it to generalise reLoc The following for the windows pipeline one. 5.5% Metric Increase: T5205 - - - - - 833e250c by Simon Peyton Jones at 2023-11-05T00:25:31-04:00 Update the unification count in wrapUnifierX Omitting this caused type inference to fail in #24146. This was an accidental omision in my refactoring of the equality solver. - - - - - e451139f by Andreas Klebinger at 2023-11-05T00:26:07-04:00 Remove an accidental git conflict marker from a comment. - - - - - 30baac7a by Tobias Haslop at 2023-11-06T10:50:32+00:00 Add laws relating between Foldable/Traversable with their Bi- superclasses See https://github.com/haskell/core-libraries-committee/issues/205 for discussion. This commit also documents that the tuple instances only satisfy the laws up to lazyness, similar to the documentation added in !9512. - - - - - df626f00 by Tobias Haslop at 2023-11-07T02:20:37-05:00 Elaborate on the quantified superclass of Bifunctor This was requested in the comment https://github.com/haskell/core-libraries-committee/issues/93#issuecomment-1597271700 for when Traversable becomes a superclass of Bitraversable, but similarly applies to Functor/Bifunctor, which already are in a superclass relationship. - - - - - 8217acb8 by Alan Zimmerman at 2023-11-07T02:21:12-05:00 EPA: get rid of l2l and friends Replace them with l2l to convert the location la2la to convert a GenLocated thing Updates haddock submodule - - - - - dd88a260 by Luite Stegeman at 2023-11-07T02:21:53-05:00 JS: remove broken newIdents from JStg Monad GHC.JS.JStg.Monad.newIdents was broken, resulting in duplicate identifiers being generated in h$c1, h$c2, ... . This change removes the broken newIdents. - - - - - 455524a2 by Matthew Craven at 2023-11-09T08:41:59-05:00 Create specially-solved DataToTag class Closes #20532. This implements CLC proposal 104: https://github.com/haskell/core-libraries-committee/issues/104 The design is explained in Note [DataToTag overview] in GHC.Tc.Instance.Class. This replaces the existing `dataToTag#` primop. These metric changes are not "real"; they represent Unique-related flukes triggering on a different set of jobs than they did previously. See also #19414. Metric Decrease: T13386 T8095 Metric Increase: T13386 T8095 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - a05f4554 by Alan Zimmerman at 2023-11-09T08:42:35-05:00 EPA: get rid of glRR and friends in GHC/Parser.y With the HasLoc and HasAnnotation classes, we can replace a number of type-specific helper functions in the parser with polymorphic ones instead Metric Decrease: MultiLayerModulesTH_Make - - - - - 18498538 by Cheng Shao at 2023-11-09T16:58:12+00:00 ci: bump ci-images for wasi-sdk upgrade - - - - - 52c0fc69 by PHO at 2023-11-09T19:16:22-05:00 Don't assume the current locale is *.UTF-8, set the encoding explicitly primops.txt contains Unicode characters: > LC_ALL=C ./genprimopcode --data-decl < ./primops.txt > genprimopcode: <stdin>: hGetContents: invalid argument (cannot decode byte sequence starting from 226) Hadrian must also avoid using readFile' to read primops.txt because it tries to decode the file with a locale-specific encoding. - - - - - 7233b3b1 by PHO at 2023-11-09T19:17:01-05:00 Use '[' instead of '[[' because the latter is a Bash-ism It doesn't work on platforms where /bin/sh is something other than Bash. - - - - - 6dbab180 by Simon Peyton Jones at 2023-11-09T19:17:36-05:00 Add an extra check in kcCheckDeclHeader_sig Fix #24083 by checking for a implicitly-scoped type variable that is not actually bound. See Note [Disconnected type variables] in GHC.Tc.Gen.HsType For some reason, on aarch64-darwin we saw a 2.8% decrease in compiler allocations for MultiLayerModulesTH_Make; but 0.0% on other architectures. Metric Decrease: MultiLayerModulesTH_Make - - - - - 22551364 by Sven Tennie at 2023-11-11T06:35:22-05:00 AArch64: Delete unused LDATA pseudo-instruction Though there were consuming functions for LDATA, there were no producers. Thus, the removed code was "dead". - - - - - 2a0ec8eb by Alan Zimmerman at 2023-11-11T06:35:59-05:00 EPA: harmonise acsa and acsA in GHC/Parser.y With the HasLoc class, we can remove the acsa helper function, using acsA instead. - - - - - 7ae517a0 by Teo Camarasu at 2023-11-12T08:04:12-05:00 nofib: bump submodule This includes changes that: - fix building a benchmark with HEAD - remove a Makefile-ism that causes errors in bash scripts Resolves #24178 - - - - - 3f0036ec by Alan Zimmerman at 2023-11-12T08:04:47-05:00 EPA: Replace Anchor with EpaLocation An Anchor has a location and an operation, which is either that it is unchanged or that it has moved with a DeltaPos data Anchor = Anchor { anchor :: RealSrcSpan , anchor_op :: AnchorOperation } An EpaLocation also has either a location or a DeltaPos data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | EpaDelta !DeltaPos ![LEpaComment] Now that we do not care about always having a location in the anchor, we remove Anchor and replace it with EpaLocation We do this with a type alias initially, to ease the transition. The alias will be removed in time. We also have helpers to reconstruct the AnchorOperation from an EpaLocation. This is also temporary. Updates Haddock submodule - - - - - a7492048 by Alan Zimmerman at 2023-11-12T13:43:07+00:00 EPA: get rid of AnchorOperation Now that the Anchor type is an alias for EpaLocation, remove AnchorOperation. Updates haddock submodule - - - - - 0745c34d by Andrew Lelechenko at 2023-11-13T16:25:07-05:00 Add since annotation for showHFloat - - - - - e98051a5 by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 Suppress duplicate librares linker warning of new macOS linker Fixes #24167 XCode 15 introduced a new linker which warns on duplicate libraries being linked. To disable this warning, we pass -Wl,-no_warn_duplicate_libraries as suggested by Brad King in CMake issue #25297. This flag isn't necessarily available to other linkers on darwin, so we must only configure it into the CC linker arguments if valid. - - - - - c411c431 by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 testsuite: Encoding test witnesses recent iconv bug is fragile A regression in the new iconv() distributed with XCode 15 and MacOS Sonoma causes the test 'encoding004' to fail in the CP936 roundrip. We mark this test as fragile until this is fixed upstream (rather than broken, since previous versions of iconv pass the test) See #24161 - - - - - ce7fe5a9 by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 testsuite: Update to LC_ALL=C no longer being ignored in darwin MacOS seems to have fixed an issue where it used to ignore the variable `LC_ALL` in program invocations and default to using Unicode. Since the behaviour seems to be fixed to account for the locale variable, we mark tests that were previously broken in spite of it as fragile (since they now pass in recent macOS distributions) See #24161 - - - - - e6c803f7 by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 darwin: Fix single_module is obsolete warning In XCode 15's linker, -single_module is the default and otherwise passing it as a flag results in a warning being raised: ld: warning: -single_module is obsolete This patch fixes this warning by, at configure time, determining whether the linker supports -single_module (which is likely false for all non-darwin linkers, and true for darwin linkers in previous versions of macOS), and using that information at runtime to decide to pass or not the flag in the invocation. Fixes #24168 - - - - - 929ba2f9 by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 testsuite: Skip MultiLayerModulesTH_Make on darwin The recent toolchain upgrade on darwin machines resulted in the MultiLayerModulesTH_Make test metrics varying too much from the baseline, ultimately blocking the CI pipelines. This commit skips the test on darwin to temporarily avoid failures due to the environment change in the runners. However, the metrics divergence is being investigated still (tracked in #24177) - - - - - af261ccd by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 configure: check target (not build) understands -no_compact_unwind Previously, we were branching on whether the build system was darwin to shortcut this check, but we really want to branch on whether the target system (which is what we are configuring ld_prog for) is darwin. - - - - - 2125c176 by Luite Stegeman at 2023-11-15T13:19:38-05:00 JS: Fix missing variable declarations The JStg IR update was missing some local variable declarations that were present earlier, causing global variables to be used implicitly (or an error in JavaScript strict mode). This adds the local variable declarations again. - - - - - 99ced73b by Krzysztof Gogolewski at 2023-11-15T13:20:14-05:00 Remove loopy superclass solve mechanism Programs with a -Wloopy-superclass-solve warning will now fail with an error. Fixes #23017 - - - - - 2aff2361 by Zubin Duggal at 2023-11-15T13:20:50-05:00 users-guide: Fix links to libraries from the users-guide. The unit-ids generated in c1a3ecde720b3bddc2c8616daaa06ee324e602ab include the package name, so we don't need to explicitly add it to the links. Fixes #24151 - - - - - 27981fac by Alan Zimmerman at 2023-11-15T13:21:25-05:00 EPA: splitLHsForAllTyInvis does not return ann We did not use the annotations returned from splitLHsForAllTyInvis, so do not return them. - - - - - a6467834 by Krzysztof Gogolewski at 2023-11-15T22:22:59-05:00 Document defaulting of RuntimeReps Fixes #24099 - - - - - 2776920e by Simon Peyton Jones at 2023-11-15T22:23:35-05:00 Second fix to #24083 My earlier fix turns out to be too aggressive for data/type families See wrinkle (DTV1) in Note [Disconnected type variables] - - - - - cee81370 by Sylvain Henry at 2023-11-16T09:57:46-05:00 Fix unusable units and module reexport interaction (#21097) This commit fixes an issue with ModUnusable introduced in df0f148feae. In mkUnusableModuleNameProvidersMap we traverse the list of unusable units and generate ModUnusable origin for all the modules they contain: exposed modules, hidden modules, and also re-exported modules. To do this we have a two-level map: ModuleName -> Unit:ModuleName (aka Module) -> ModuleOrigin So for each module name "M" in broken unit "u" we have: "M" -> u:M -> ModUnusable reason However in the case of module reexports we were using the *target* module as a key. E.g. if "u:M" is a reexport for "X" from unit "o": "M" -> o:X -> ModUnusable reason Case 1: suppose a reexport without module renaming (u:M -> o:M) from unusable unit u: "M" -> o:M -> ModUnusable reason Here it's claiming that the import of M is unusable because a reexport from u is unusable. But if unit o isn't unusable we could also have in the map: "M" -> o:M -> ModOrigin ... Issue: the Semigroup instance of ModuleOrigin doesn't handle the case (ModUnusable <> ModOrigin) Case 2: similarly we could have 2 unusable units reexporting the same module without renaming, say (u:M -> o:M) and (v:M -> o:M) with u and v unusable. It gives: "M" -> o:M -> ModUnusable ... (for u) "M" -> o:M -> ModUnusable ... (for v) Issue: the Semigroup instance of ModuleOrigin doesn't handle the case (ModUnusable <> ModUnusable). This led to #21097, #16996, #11050. To fix this, in this commit we make ModUnusable track whether the module used as key is a reexport or not (for better error messages) and we use the re-export module as key. E.g. if "u:M" is a reexport for "o:X" and u is unusable, we now record: "M" -> u:M -> ModUnusable reason reexported=True So now, we have two cases for a reexport u:M -> o:X: - u unusable: "M" -> u:M -> ModUnusable ... reexported=True - u usable: "M" -> o:X -> ModOrigin ... reexportedFrom=u:M The second case is indexed with o:X because in this case the Semigroup instance of ModOrigin is used to combine valid expositions of a module (directly or via reexports). Note that module lookup functions select usable modules first (those who have a ModOrigin value), so it doesn't matter if we add new ModUnusable entries in the map like this: "M" -> { u:M -> ModUnusable ... reexported=True o:M -> ModOrigin ... } The ModOrigin one will be used. Only if there is no ModOrigin or ModHidden entry will the ModUnusable error be printed. See T21097 for an example printing several reasons why an import is unusable. - - - - - 3e606230 by Krzysztof Gogolewski at 2023-11-16T09:58:22-05:00 Fix IPE test A helper function was defined in a different module than used. To reproduce: ./hadrian/build test --test-root-dirs=testsuite/tests/rts/ipe - - - - - 49f5264b by Andreas Klebinger at 2023-11-16T20:52:11-05:00 Properly compute unpacked sizes for -funpack-small-strict-fields. Use rep size rather than rep count to compute the size. Fixes #22309 - - - - - b4f84e4b by James Henri Haydon at 2023-11-16T20:52:53-05:00 Explicit methods for Alternative Compose Explicitly define some and many in Alternative instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/181 - - - - - 9bc0dd1f by Ignat Insarov at 2023-11-16T20:53:34-05:00 Add permutations for non-empty lists. Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/68#issuecomment-1221409837 - - - - - 5643ecf9 by Andrew Lelechenko at 2023-11-16T20:53:34-05:00 Update changelog and since annotations for Data.List.NonEmpty.permutations Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/68#issuecomment-1221409837 - - - - - 94ff2134 by Oleg Alexander at 2023-11-16T20:54:15-05:00 Update doc string for traceShow Updated doc string for traceShow. - - - - - faff671a by Luite Stegeman at 2023-11-17T14:12:51+01:00 JS: clean up some foreign imports - - - - - 856e0a4e by Sven Tennie at 2023-11-18T06:54:11-05:00 AArch64: Remove unused instructions As these aren't ever emitted, we don't even know if they work or will ever be used. If one of them is needed in future, we may easily re-add it. Deleted instructions are: - CMN - ANDS - BIC - BICS - EON - ORN - ROR - TST - STP - LDP - DMBSY - - - - - 615441ef by Alan Zimmerman at 2023-11-18T06:54:46-05:00 EPA: Replace Monoid with NoAnn Remove the final Monoid instances in the exact print infrastructure. For Windows CI Metric Decrease: T5205 - - - - - 5a6c49d4 by David Feuer at 2023-11-20T18:53:18-05:00 Speed up stimes in instance Semigroup Endo As discussed at https://github.com/haskell/core-libraries-committee/issues/4 - - - - - cf9da4b3 by Andrew Lelechenko at 2023-11-20T18:53:18-05:00 base: reflect latest changes in the changelog - - - - - 48bf364e by Alan Zimmerman at 2023-11-20T18:53:54-05:00 EPA: Use SrcSpan in EpaSpan This is more natural, since we already need to deal with invalid RealSrcSpans, and that is exactly what SrcSpan.UnhelpfulSpan is for. Updates haddock submodule. - - - - - 97ec37cc by Sebastian Graf at 2023-11-20T18:54:31-05:00 Add regression test for #6070 Fixes #6070. - - - - - e9d5ae41 by Owen Shepherd at 2023-11-21T18:32:23-05:00 chore: Correct typo in the gitlab MR template [skip ci] - - - - - f158a8d0 by Rodrigo Mesquita at 2023-11-21T18:32:59-05:00 Improve error message when reading invalid `.target` files A `.target` file generated by ghc-toolchain or by configure can become invalid if the target representation (`Toolchain.Target`) is changed while the files are not re-generated by calling `./configure` or `ghc-toolchain` again. There is also the issue of hadrian caching the dependencies on `.target` files, which makes parsing fail when reading reading the cached value if the representation has been updated. This patch provides a better error message in both situations, moving away from a terrible `Prelude.read: no parse` error that you would get otherwise. Fixes #24199 - - - - - 955520c6 by Ben Gamari at 2023-11-21T18:33:34-05:00 users guide: Note that QuantifiedConstraints implies ExplicitForAll Fixes #24025. - - - - - 17ec3e97 by Owen Shepherd at 2023-11-22T09:37:28+01:00 fix: Change type signatures in NonEmpty export comments to reflect reality This fixes several typos in the comments of Data.List.NonEmpty export list items. - - - - - 2fd78f9f by Samuel Thibault at 2023-11-22T11:49:13-05:00 Fix the platform string for GNU/Hurd As commited in Cargo https://github.com/haskell/cabal/pull/9434 there is confusion between "gnu" and "hurd". This got fixed in Cargo, we need the converse in Hadrian. Fixes #24180 - - - - - a79960fe by Alan Zimmerman at 2023-11-22T11:49:48-05:00 EPA: Tuple Present no longer has annotation The Present constructor for a Tuple argument will never have an exact print annotation. So make this impossible. - - - - - 121c9ab7 by David Binder at 2023-11-22T21:12:29-05:00 Unify the hpc testsuites The hpc testsuite was split between testsuite/tests/hpc and the submodule libraries/hpc/test. This commit unifies the two testsuites in the GHC repository in the directory testsuite/tests/hpc. - - - - - d2733a05 by Alan Zimmerman at 2023-11-22T21:13:05-05:00 EPA: empty tup_tail has noAnn In Parser.y, the tup_tail rule had the following option | {- empty -} %shift { return [Left noAnn] } Once this works through PostProcess.hs, it means we add an extra Missing constructor if the last item was a comma. Change the annotation type to a Bool to indicate this, and use the EpAnn Anchor for the print location for the others. - - - - - fa576eb8 by Andreas Klebinger at 2023-11-24T08:29:13-05:00 Fix FMA primops generating broken assembly on x86. `genFMA3Code` assumed that we had to take extra precations to avoid overwriting the result of `getNonClobberedReg`. One of these special cases caused a bug resulting in broken assembly. I believe we don't need to hadle these cases specially at all, which means this MR simply deletes the special cases to fix the bug. Fixes #24160 - - - - - 34d86315 by Alan Zimmerman at 2023-11-24T08:29:49-05:00 EPA: Remove parenthesizeHsType This is called from PostProcess.hs, and adds spurious parens. With the looser version of exact printing we had before we could tolerate this, as they would be swallowed by the original at the same place. But with the next change (remove EpAnnNotUsed) they result in duplicates in the output. For Darwin build: Metric Increase: MultiLayerModulesTH_OneShot - - - - - 3ede659d by Vladislav Zavialov at 2023-11-26T06:43:32-05:00 Add name for -Wdeprecated-type-abstractions (#24154) This warning had no name or flag and was triggered unconditionally. Now it is part of -Wcompat. - - - - - 7902ebf8 by Alan Zimmerman at 2023-11-26T06:44:08-05:00 EPA: Remove EpAnnNotUsed We no longer need the EpAnnNotUsed constructor for EpAnn, as we can represent an unused annotation with an anchor having a EpaDelta of zero, and empty comments and annotations. This simplifies code handling annotations considerably. Updates haddock submodule Metric Increase: parsing001 - - - - - 471b2672 by Mario Blažević at 2023-11-26T06:44:48-05:00 Bumped the upper bound of text to <2.2 - - - - - d1bf25c7 by Vladislav Zavialov at 2023-11-26T11:45:49-05:00 Term variable capture (#23740) This patch changes type variable lookup rules (lookupTypeOccRn) and implicit quantification rules (filterInScope) so that variables bound in the term namespace can be captured at the type level {-# LANGUAGE RequiredTypeArguments #-} f1 x = g1 @x -- `x` used in a type application f2 x = g2 (undefined :: x) -- `x` used in a type annotation f3 x = g3 (type x) -- `x` used in an embedded type f4 x = ... where g4 :: x -> x -- `x` used in a type signature g4 = ... This change alone does not allow us to accept examples shown above, but at least it gets them past the renamer. - - - - - da863d15 by Vladislav Zavialov at 2023-11-26T11:46:26-05:00 Update Note [hsScopedTvs and visible foralls] The Note was written before GHC gained support for visible forall in types of terms. Rewrite a few sentences and use a better example. - - - - - b5213542 by Matthew Pickering at 2023-11-27T12:53:59-05:00 testsuite: Add mechanism to collect generic metrics * Generalise the metric logic by adding an additional field which allows you to specify how to query for the actual value. Previously the method of querying the baseline value was abstracted (but always set to the same thing). * This requires rejigging how the stat collection works slightly but now it's more uniform and hopefully simpler. * Introduce some new "generic" helper functions for writing generic stats tests. - collect_size ( deviation, path ) Record the size of the file as a metric - stat_from_file ( metric, deviation, path ) Read a value from the given path, and store that as a metric - collect_generic_stat ( metric, deviation, get_stat) Provide your own `get_stat` function, `lambda way: <Int>`, which can be used to establish the current value of the metric. - collect_generic_stats ( metric_info ): Like collect_generic_stat but provide the whole dictionary of metric definitions. { metric: { deviation: <Int> current: lambda way: <Int> } } * Introduce two new "size" metrics for keeping track of build products. - `size_hello_obj` - The size of `hello.o` from compiling hello.hs - `libdir` - The total size of the `libdir` folder. * Track the number of modules in the AST tests - CountDepsAst - CountDepsParser This lays the infrastructure for #24191 #22256 #17129 - - - - - 7d9a2e44 by ARATA Mizuki at 2023-11-27T12:54:39-05:00 x86: Don't require -mavx2 when using 256-bit floating-point SIMD primitives Fixes #24222 - - - - - 4e5ff6a4 by Alan Zimmerman at 2023-11-27T12:55:15-05:00 EPA: Remove SrcSpanAnn Now that we only have a single constructor for EpAnn, And it uses a SrcSpan for its location, we can do away with SrcSpanAnn completely. It only existed to wrap the original SrcSpan in a location, and provide a place for the exact print annotation. For darwin only: Metric Increase: MultiLayerModulesTH_OneShot Updates haddock submodule - - - - - e05bca39 by Krzysztof Gogolewski at 2023-11-28T08:00:55-05:00 testsuite: don't initialize testdir to '.' The test directory is removed during cleanup, if there's an interrupt that could remove the entire repository. Fixes #24219 - - - - - af881674 by Alan Zimmerman at 2023-11-28T08:01:30-05:00 EPA: Clean up mkScope in Ast.hs Now that we have HasLoc we can get rid of all the custom variants of mkScope For deb10-numa Metric Increase: libdir - - - - - 292983c8 by Ben Gamari at 2023-11-28T22:44:28-05:00 distrib: Rediscover otool and install_name_tool on Darwin In the bindist configure script we must rediscover the `otool` and `install_name_tool`s since they may be different from the build environment. Fixes #24211. - - - - - dfe1c354 by Stefan Schulze Frielinghaus at 2023-11-28T22:45:04-05:00 llvmGen: Align objects in the data section Objects in the data section may be referenced via tagged pointers. Thus, align those objects to a 4- or 8-byte boundary for 32- or 64-bit platforms, respectively. Note, this may need to be reconsidered if objects with a greater natural alignment requirement are emitted as e.g. 128-bit atomics. Fixes #24163. - - - - - f6c486c3 by Matthew Pickering at 2023-11-29T11:08:13-05:00 metrics: Widen libdir and size_hello_obj acceptance window af8816740d9b8759be1a22af8adcb5f13edeb61d shows that the libdir size can fluctuate quite significantly even when the change is quite small. Therefore we widen the acceptance window to 10%. - - - - - 99a6a49c by Alan Zimmerman at 2023-11-29T11:08:49-05:00 EPA: Clean up TC Monad Utils We no longer need the alternative variant of addLocM (addLocMA) nor wrapLocAM, wrapLocSndMA. aarch64-darwin Metric Increase: MultiLayerModulesTH_OneShot deb10-numa-slow Metric Decrease: libdir - - - - - cbc03fa0 by Sebastian Graf at 2023-11-30T12:37:21-05:00 perf tests: Move comments into new `Note [Sensitivity to unique increment]` (#19414) And additionally to T12545, link from T8095, T13386 to this new Note. - - - - - c7623b22 by Alan Zimmerman at 2023-11-30T12:37:56-05:00 EPA: EpaDelta for comment has no comments EpaLocation is used to position things. It has two constructors, EpaSpan holding a SrcSpan, and EpaDelta with a delta position and a possible list of comments. The comment list is needed because the location in EpaDelta has no absolute information to decide which comments should be emitted before them when printing. But it is also used for specifying the position of a comment. To prevent the absurdity of a comment position having a list of comments in it, we make EpaLocation parameterisable, using comments for the normal case and a constant for within comments. Updates haddock submodule. aarch64-darwin Metric Decrease: MultiLayerModulesTH_OneShot - - - - - bd8acc0c by Krzysztof Gogolewski at 2023-11-30T12:38:32-05:00 Kind-check body of a required forall We now require that in 'forall a -> ty', ty has kind TYPE r for some r. Fixes #24176 - - - - - 010fb784 by Owen Shepherd at 2023-12-03T00:10:09-05:00 docs(NonEmpty/group): Remove incorrect haddock link quotes in code block - - - - - cda9c12d by Owen Shepherd at 2023-12-03T00:10:09-05:00 docs(NonEmpty/group): Remove cycle from group haddock example - - - - - 495265b9 by Owen Shepherd at 2023-12-03T00:10:09-05:00 docs(NonEmpty/group): Use repl haddock syntax in group docs - - - - - d134d1de by Owen Shepherd at 2023-12-03T00:10:09-05:00 docs(NonEmpty/group): Use list [] notation in group haddock - - - - - dfcf629c by Owen Shepherd at 2023-12-03T00:10:10-05:00 docs(NonEmpty/group): Specify final property of group function in haddock - - - - - cad3b734 by Owen Shepherd at 2023-12-03T00:10:10-05:00 fix: Add missing property of List.group - - - - - bad37656 by Matthew Pickering at 2023-12-03T00:10:46-05:00 testsuite: Fix T21097b test with make 4.1 (deb9) cee81370cd6ef256f66035e3116878d4cb82e28b recently added a test which failed on deb9 because the version of make was emitting the recipe failure to stdout rather than stderr. One way to fix this is to be more precise in the test about which part of the output we care about inspecting. - - - - - 5efdf421 by Matthew Pickering at 2023-12-03T00:11:21-05:00 testsuite: Track size of libdir in bytes For consistency it's better if we track all size metrics in bytes. Metric Increase: libdir - - - - - f5eb0f29 by Matthew Pickering at 2023-12-03T00:11:22-05:00 testsuite: Remove rogue trace in testsuite I accidentally left a trace in the generics metric patch. - - - - - d5610737 by Claudio Bley at 2023-12-06T16:13:33-05:00 Only exit ghci in -e mode when :add command fails Previously, when running `ghci -e ':add Sample.hs'` the process would exit with exit code 1 if the file exists and could be loaded. Fixes #24115 - - - - - 0f0c53a5 by Vladislav Zavialov at 2023-12-06T16:14:09-05:00 T2T in Patterns (#23739) This patch implements the T2T (term-to-type) transformation in patterns. Patterns that are checked against a visible forall can now be written without the `type` keyword: \(type t) (x :: t) -> ... -- old \t (x :: t) -> ... -- new The `t` binder is parsed and renamed as a term pattern (Pat), but then undergoes a conversion to a type pattern (HsTyPat). See the new function pat_to_type_pat in compiler/GHC/Tc/Gen/Pat.hs - - - - - 10a1a6c6 by Sebastian Graf at 2023-12-06T16:14:45-05:00 Pmc: Fix SrcLoc and warning for incomplete irrefutable pats (#24234) Before, the source location would point at the surrounding function definition, causing the confusion in #24234. I also took the opportunity to introduce a new `LazyPatCtx :: HsMatchContext _` to make the warning message say "irrefutable pattern" instead of "pattern binding". - - - - - 36b9a38c by Matthew Pickering at 2023-12-06T16:15:21-05:00 libraries: Bump filepath to 1.4.200.1 and unix to 2.8.4.0 Updates filepath submodule Updates unix submodule Fixes #24240 - - - - - 91ff0971 by Matthew Pickering at 2023-12-06T16:15:21-05:00 Submodule linter: Allow references to tags We modify the submodule linter so that if the bumped commit is a specific tag then the commit is accepted. Fixes #24241 - - - - - 86f652dc by Zubin Duggal at 2023-12-06T16:15:21-05:00 hadrian: set -Wno-deprecations for directory and Win32 The filepath bump to 1.4.200.1 introduces a deprecation warning. See https://gitlab.haskell.org/ghc/ghc/-/issues/24240 https://github.com/haskell/filepath/pull/206 - - - - - 7ac6006e by Sylvain Henry at 2023-12-06T16:16:02-05:00 Zap OccInfo on case binders during StgCse #14895 #24233 StgCse can revive dead binders: case foo of dead { Foo x y -> Foo x y; ... } ===> case foo of dead { Foo x y -> dead; ... } -- dead is no longer dead So we must zap occurrence information on case binders. Fix #14895 and #24233 - - - - - 57c391c4 by Sebastian Graf at 2023-12-06T16:16:37-05:00 Cpr: Turn an assertion into a check to deal with some dead code (#23862) See the new `Note [Dead code may contain type confusions]`. Fixes #23862. - - - - - c1c8abf8 by Zubin Duggal at 2023-12-08T02:25:07-05:00 testsuite: add test for #23944 - - - - - 6329d308 by Zubin Duggal at 2023-12-08T02:25:07-05:00 driver: Only run a dynamic-too pipeline if object files are going to be generated Otherwise we run into a panic in hscMaybeWriteIface: "Unexpected DT_Dyn state when writing simple interface" when dynamic-too is enabled We could remove the panic and just write the interface even if the state is `DT_Dyn`, but it seems pointless to run the pipeline twice when `hscMaybeWriteIface` is already designed to write both `hi` and `dyn_hi` files if dynamic-too is enabled. Fixes #23944. - - - - - 28811f88 by Simon Peyton Jones at 2023-12-08T05:47:18-05:00 Improve duplicate elimination in SpecConstr This partially fixes #24229. See the new Note [Pattern duplicate elimination] in SpecConstr - - - - - fec7894f by Simon Peyton Jones at 2023-12-08T05:47:18-05:00 Make SpecConstr deal with casts better This patch does two things, to fix #23209: * It improves SpecConstr so that it no longer quantifies over coercion variables. See Note [SpecConstr and casts] * It improves the rule matcher to deal nicely with the case where the rule does not quantify over coercion variables, but the the template has a cast in it. See Note [Casts in the template] - - - - - 8db8d2fd by Zubin Duggal at 2023-12-08T05:47:54-05:00 driver: Don't lose track of nodes when we fail to resolve cycles The nodes that take part in a cycle should include both hs-boot and hs files, but when we fail to resolve a cycle, we were only counting the nodes from the graph without boot files. Fixes #24196 - - - - - c5b4efd3 by Zubin Duggal at 2023-12-08T05:48:30-05:00 testsuite: Skip MultiLayerModulesTH_OneShot on darwin See #24177 - - - - - fae472a9 by Wendao Lee at 2023-12-08T05:49:12-05:00 docs(Data.Char):Add more detailed descriptions for some functions Related changed function's docs: -GHC.Unicode.isAlpha -GHC.Unicode.isPrint -GHC.Unicode.isAlphaNum Add more details for what the function will return. Co-authored-by: Bodigrim <andrew.lelechenko at gmail.com> - - - - - ca7510e4 by Malik Ammar Faisal at 2023-12-08T05:49:55-05:00 Fix float parsing in GHC Cmm Lexer Add test case for bug #24224 - - - - - d8baa1bd by Simon Peyton Jones at 2023-12-08T15:40:37+00:00 Take care when simplifying unfoldings This MR fixes a very subtle bug exposed by #24242. See Note [Environment for simplLetUnfolding]. I also updated a bunch of Notes on shadowing - - - - - 03ca551d by Simon Peyton Jones at 2023-12-08T15:54:50-05:00 Comments only in FloatIn Relevant to #3458 - - - - - 50c78779 by Simon Peyton Jones at 2023-12-08T15:54:50-05:00 Comments only in SpecConstr - - - - - 9431e195 by Simon Peyton Jones at 2023-12-08T15:54:50-05:00 Add test for #22238 - - - - - d9e4c597 by Vladislav Zavialov at 2023-12-11T04:19:34-05:00 Make forall a keyword (#23719) Before this change, GHC used to accept `forall` as a term-level identifier: -- from constraints-0.13 forall :: forall p. (forall a. Dict (p a)) -> Dict (Forall p) forall d = ... Now it is a parse error. The -Wforall-identifier warning has served its purpose and is now a deprecated no-op. - - - - - 58d56644 by Zubin Duggal at 2023-12-11T04:20:10-05:00 driver: Ensure we actually clear the interactive context before reloading Previously we called discardIC, but immediately after set the session back to an old HscEnv that still contained the IC Partially addresses #24107 Fixes #23405 - - - - - 8e5745a0 by Zubin Duggal at 2023-12-11T04:20:10-05:00 driver: Ensure we force the lookup of old build artifacts before returning the build plan This prevents us from retaining all previous build artifacts in memory until a recompile finishes, instead only retaining the exact artifacts we need. Fixes #24118 - - - - - 105c370c by Zubin Duggal at 2023-12-11T04:20:10-05:00 testsuite: add test for #24118 and #24107 MultiLayerModulesDefsGhci was not able to catch the leak because it uses :l which discards the previous environment. Using :r catches both of these leaks - - - - - e822ff88 by Zubin Duggal at 2023-12-11T04:20:10-05:00 compiler: Add some strictness annotations to ImportSpec and related constructors This prevents us from retaining entire HscEnvs. Force these ImportSpecs when forcing the GlobalRdrEltX Adds an NFData instance for Bag Fixes #24107 - - - - - 522c12a4 by Zubin Duggal at 2023-12-11T04:20:10-05:00 compiler: Force IfGlobalRdrEnv in NFData instance. - - - - - 188b280d by Arnaud Spiwack at 2023-12-11T15:33:31+01:00 LinearTypes => MonoLocalBinds - - - - - 8e0446df by Arnaud Spiwack at 2023-12-11T15:44:28+01:00 Linear let and where bindings For expediency, the initial implementation of linear types in GHC made it so that let and where binders would always be considered unrestricted. This was rather unpleasant, and probably a big obstacle to adoption. At any rate, this was not how the proposal was designed. This patch fixes this infelicity. It was surprisingly difficult to build, which explains, in part, why it took so long to materialise. As of this patch, let or where bindings marked with %1 will be linear (respectively %p for an arbitrary multiplicity p). Unmarked let will infer their multiplicity. Here is a prototypical example of program that used to be rejected and is accepted with this patch: ```haskell f :: A %1 -> B g :: B %1 -> C h :: A %1 -> C h x = g y where y = f x ``` Exceptions: - Recursive let are unrestricted, as there isn't a clear semantics of what a linear recursive binding would be. - Destructive lets with lazy bindings are unrestricted, as their desugaring isn't linear (see also #23461). - (Strict) destructive lets with inferred polymorphic type are unrestricted. Because the desugaring isn't linear (See #18461 down-thread). Closes #18461 and #18739 Co-authored-by: @jackohughes - - - - - effa7e2d by Matthew Craven at 2023-12-12T04:37:20-05:00 Introduce `dataToTagSmall#` primop (closes #21710) ...and use it to generate slightly better code when dataToTag# is used at a "small data type" where there is no need to mess with "is_too_big_tag" or potentially look at an info table. Metric Decrease: T18304 - - - - - 35c7aef6 by Matthew Craven at 2023-12-12T04:37:20-05:00 Fix formatting of Note [alg-alt heap check] - - - - - 7397c784 by Oleg Grenrus at 2023-12-12T04:37:56-05:00 Allow untyped brackets in typed splices and vice versa. Resolves #24190 Apparently the check was essentially always (as far as I can trace back: d0d47ba76f8f0501cf3c4966bc83966ab38cac27), and while it does catch some mismatches, the type-checker will catch them too. OTOH, it prevents writing completely reasonable programs. - - - - - a3ee3b99 by Moritz Angermann at 2023-12-12T19:50:58-05:00 Drop hard Xcode dependency XCODE_VERSION calls out to `xcodebuild`, which is only available when having `Xcode` installed. The CommandLineTools are not sufficient. To install Xcode, you must have an apple id to download the Xcode.xip from apple. We do not use xcodebuild anywhere in our build explicilty. At best it appears to be a proxy for checking the linker or the compiler. These should rather be done with ``` xcrun ld -version ``` or similar, and not by proxy through Xcode. The CLR should be sufficient for building software on macOS. - - - - - 1c9496e0 by Vladislav Zavialov at 2023-12-12T19:51:34-05:00 docs: update information on RequiredTypeArguments Update the User's Guide and Release Notes to account for the recent progress in the implementation of RequiredTypeArguments. - - - - - d0b17576 by Ben Gamari at 2023-12-13T06:33:37-05:00 rts/eventlog: Fix off-by-one in assertion Previously we failed to account for the NULL terminator `postString` asserted that there is enough room in the buffer for the string. - - - - - a10f9b9b by Ben Gamari at 2023-12-13T06:33:37-05:00 rts/eventlog: Honor result of ensureRoomForVariableEvent is Previously we would keep plugging along, even if isn't enough room for the event. - - - - - 0e0f41c0 by Ben Gamari at 2023-12-13T06:33:37-05:00 rts/eventlog: Avoid truncating event sizes Previously ensureRoomForVariableEvent would truncate the desired size to 16-bits, resulting in #24197. Fixes #24197. - - - - - 64e724c8 by Artin Ghasivand at 2023-12-13T06:34:20-05:00 Remove the "Derived Constraint" argument of TcPluginSolver, docs - - - - - fe6d97dd by Vladislav Zavialov at 2023-12-13T06:34:56-05:00 EPA: Move tokens into GhcPs extension fields (#23447) Summary of changes * Remove Language.Haskell.Syntax.Concrete * Move all tokens into GhcPs extension fields (LHsToken -> EpToken) * Create new TTG extension fields as needed * Drop the MultAnn wrapper Updates the haddock submodule. Co-authored-by: Alan Zimmerman <alan.zimm at gmail.com> - - - - - 8106e695 by Zubin Duggal at 2023-12-13T06:35:34-05:00 testsuite: use copy_files in T23405 This prevents the tree from being dirtied when the file is modified. - - - - - ed0e4099 by Bryan Richter at 2023-12-14T04:30:53-05:00 Document ghc package's PVP-noncompliance This changes nothing, it just makes the status quo explicit. - - - - - 8bef8d9f by Luite Stegeman at 2023-12-14T04:31:33-05:00 JS: Mark spurious CI failures js_fragile(24259) This marks the spurious test failures on the JS platform as js_fragile(24259), so we don't hold up merge requests while fixing the underlying issues. See #24259 - - - - - 1c79526a by Finley McIlwaine at 2023-12-15T12:24:40-08:00 Late plugins - - - - - 000c3302 by Finley McIlwaine at 2023-12-15T12:24:40-08:00 withTiming on LateCCs and late plugins - - - - - be4551ac by Finley McIlwaine at 2023-12-15T12:24:40-08:00 add test for late plugins - - - - - 7c29da9f by Finley McIlwaine at 2023-12-15T12:24:40-08:00 Document late plugins - - - - - 9a52ae46 by Ben Gamari at 2023-12-20T07:07:26-05: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. - - - - - f4b53538 by Vladislav Zavialov at 2023-12-20T07:08:02-05:00 docs: Fix link to 051-ghc-base-libraries.rst The proposal is no longer available at the previous URL. - - - - - f7e21fab by Matthew Pickering at 2023-12-21T14:57:40+00:00 hadrian: Build all executables in bin/ folder In the end the bindist creation logic copies them all into the bin folder. There is no benefit to building a specific few binaries in the lib/bin folder anymore. This also removes the ad-hoc logic to copy the touchy and unlit executables from stage0 into stage1. It takes <1s to build so we might as well just build it. - - - - - 0038d052 by Zubin Duggal at 2023-12-22T23:28:00-05:00 testsuite: mark jspace as fragile on i386. This test has been flaky for some time and has been failing consistently on i386-linux since 8e0446df landed. See #24261 - - - - - dfd670a0 by Ben Bellick at 2023-12-24T10:10:31-05:00 Deprecate -ddump-json and introduce -fdiagnostics-as-json Addresses #19278 This commit deprecates the underspecified -ddump-json flag and introduces a newer, well-specified flag -fdiagnostics-as-json. Also included is a JSON schema as part of the documentation. The -ddump-json flag will be slated for removal shortly after this merge. - - - - - 609e6225 by Ben Bellick at 2023-12-24T10:10:31-05:00 Deprecate -ddump-json and introduce -fdiagnostics-as-json Addresses #19278 This commit deprecates the underspecified -ddump-json flag and introduces a newer, well-specified flag -fdiagnostics-as-json. Also included is a JSON schema as part of the documentation. The -ddump-json flag will be slated for removal shortly after this merge. - - - - - 865513b2 by Ömer Sinan Ağacan at 2023-12-24T10:11:13-05:00 Fix BNF in user manual 6.6.8.2: formal syntax for instance declarations - - - - - c247b6be by Zubin Duggal at 2023-12-25T16:01:23-05:00 docs: document permissibility of -XOverloadedLabels (#24249) Document the permissibility introduced by https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst - - - - - e5b7eb59 by Ömer Sinan Ağacan at 2023-12-25T16:02:03-05:00 Fix a code block syntax in user manual sec. 6.8.8.6 - - - - - 2db11c08 by Ben Gamari at 2023-12-29T15:35:48-05:00 genSym: Reimplement via CAS on 32-bit platforms Previously the remaining use of the C implementation on 32-bit platforms resulted in a subtle bug, #24261. This was due to the C object (which used the RTS's `atomic_inc64` macro) being compiled without `-threaded` yet later being used in a threaded compiler. Side-step this issue by using the pure Haskell `genSym` implementation on all platforms. This required implementing `fetchAddWord64Addr#` in terms of CAS on 64-bit platforms. - - - - - 19328a8c by Xiaoyan Ren at 2023-12-29T15:36:30-05:00 Do not color the diagnostic code in error messages (#24172) - - - - - 685b467c by Krzysztof Gogolewski at 2023-12-29T15:37:06-05:00 Enforce that bindings of implicit parameters are lifted Fixes #24298 - - - - - bc4d67b7 by Matthew Craven at 2023-12-31T06:15:42-05:00 StgToCmm: Detect some no-op case-continuations ...and generate no code for them. Fixes #24264. - - - - - 5b603139 by Krzysztof Gogolewski at 2023-12-31T06:16:18-05:00 Revert "testsuite: mark jspace as fragile on i386." This reverts commit 0038d052c8c80b4b430bb2aa1c66d5280be1aa95. The atomicity bug should be fixed by !11802. - - - - - d55216ad by Krzysztof Gogolewski at 2024-01-01T12:05:49-05:00 Refactor: store [[PrimRep]] rather than [Type] in STG StgConApp stored a list of types. This list was used exclusively during unarisation of unboxed sums (mkUbxSum). However, this is at a wrong level of abstraction: STG shouldn't be concerned with Haskell types, only PrimReps. Update the code to store a [[PrimRep]]. Also, there's no point in storing this list when we're not dealing with an unboxed sum. - - - - - 8b340bc7 by Ömer Sinan Ağacan at 2024-01-01T12:06:29-05:00 Kind signatures docs: mention that they're allowed in newtypes - - - - - 989bf8e5 by Zubin Duggal at 2024-01-03T20:08:47-05:00 ci: Ensure we use the correct bindist name for the test artifact when generating release ghcup metadata Fixes #24268 - - - - - 89299a89 by Krzysztof Gogolewski at 2024-01-03T20:09:23-05:00 Refactor: remove calls to typePrimRepArgs The function typePrimRepArgs is just a thin wrapper around typePrimRep, adding a VoidRep if the list is empty. However, in StgToByteCode, we were discarding that VoidRep anyway, so there's no point in calling it. - - - - - c7be0c68 by mmzk1526 at 2024-01-03T20:10:07-05:00 Use "-V" for alex version check for better backward compatibility Fixes #24302. In recent versions of alex, "-v" is used for "--verbose" instead of "-version". - - - - - 67dbcc0a by Krzysztof Gogolewski at 2024-01-05T02:07:18-05:00 Fix VoidRep handling in ghci debugger 'go' inside extractSubTerms was giving a bad result given a VoidRep, attempting to round towards the next multiple of 0. I don't understand much about the debugger but the code should be better than it was. Fixes #24306 - - - - - 90ea574e by Krzysztof Gogolewski at 2024-01-05T02:07:54-05:00 VoidRep-related refactor * In GHC.StgToByteCode, replace bcIdPrimId with idPrimRep, bcIdArgRep with idArgRep, atomPrimRep with stgArgRep1. All of them were duplicates. * In GHC.Stg.Unarise, we were converting a PrimRep to a Type and back to PrimRep. Remove the calls to primRepToType and typePrimRep1 which cancel out. * In GHC.STG.Lint, GHC.StgToCmm, GHC.Types.RepType we were filtering out VoidRep from the result of typePrimRep. But typePrimRep never returns VoidRep - remove the filtering. - - - - - eaf72479 by brian at 2024-01-06T23:03:09-05:00 Add unaligned Addr# primops Implements CLC proposal #154: https://github.com/haskell/core-libraries-committee/issues/154 * add unaligned addr primops * add tests * accept tests * add documentation * fix js primops * uncomment in access ops * use Word64 in tests * apply suggestions * remove extra file * move docs * remove random options * use setByteArray# primop * better naming * update base-exports test * add base-exports for other architectures - - - - - d471d445 by Krzysztof Gogolewski at 2024-01-06T23:03:47-05:00 Remove VoidRep from PrimRep, introduce PrimOrVoidRep This introduces data PrimOrVoidRep = VoidRep | NVRep PrimRep changes typePrimRep1 to return PrimOrVoidRep, and adds a new function typePrimRepU to be used when the argument is definitely non-void. Details in Note [VoidRep] in GHC.Types.RepType. Fixes #19520 - - - - - 48720a07 by Matthew Craven at 2024-01-08T18:57:36-05:00 Apply Note [Sensitivity to unique increment] to LargeRecord - - - - - 9e2e180f by Sebastian Graf at 2024-01-08T18:58:13-05:00 Debugging: Add diffUFM for convenient diffing between UniqFMs - - - - - 948f3e35 by Sebastian Graf at 2024-01-08T18:58:13-05:00 Rename Opt_D_dump_stranal to Opt_D_dump_dmdanal ... and Opt_D_dump_str_signatures to Opt_D_dump_dmd_signatures - - - - - 4e217e3e by Sebastian Graf at 2024-01-08T18:58:13-05:00 Deprecate -ddump-stranal and -ddump-str-signatures ... and suggest -ddump-dmdanal and -ddump-dmd-signatures instead - - - - - 6c613c90 by Sebastian Graf at 2024-01-08T18:58:13-05:00 Move testsuite/tests/stranal to testsuite/tests/dmdanal A separate commit so that the rename is obvious to Git(Lab) - - - - - c929f02b by Sebastian Graf at 2024-01-08T18:58:13-05:00 CoreSubst: Stricten `substBndr` and `cloneBndr` Doing so reduced allocations of `cloneBndr` by about 25%. ``` T9233(normal) ghc/alloc 672,488,656 663,083,216 -1.4% GOOD T9675(optasm) ghc/alloc 423,029,256 415,812,200 -1.7% geo. mean -0.1% minimum -1.7% maximum +0.1% ``` Metric Decrease: T9233 - - - - - e3ca78f3 by Krzysztof Gogolewski at 2024-01-10T17:35:59-05:00 Deprecate -Wsemigroup This warning was used to prepare for Semigroup becoming a superclass of Monoid, and for (<>) being exported from Prelude. This happened in GHC 8.4 in 8ae263ceb3566 and feac0a3bc69fd3. The leftover logic for (<>) has been removed in GHC 9.8, 4d29ecdfcc79. Now the warning does nothing at all and can be deprecated. - - - - - 08d14925 by amesgen at 2024-01-10T17:36:42-05:00 WASM metadata: use correct GHC version - - - - - 7a808419 by Xiaoyan Ren at 2024-01-10T17:37:24-05:00 Allow SCC declarations in TH (#24081) - - - - - 28827c51 by Xiaoyan Ren at 2024-01-10T17:37:24-05:00 Fix prettyprinting of SCC pragmas - - - - - ae9cc1a8 by Matthew Craven at 2024-01-10T17:38:01-05:00 Fix loopification in the presence of void arguments This also removes Note [Void arguments in self-recursive tail calls], which was just misleading. It's important to count void args both in the function's arity and at the call site. Fixes #24295. - - - - - b718b145 by Zubin Duggal at 2024-01-10T17:38:36-05:00 testsuite: Teach testsuite driver about c++ sources - - - - - 09cb57ad by Zubin Duggal at 2024-01-10T17:38:36-05:00 driver: Set -DPROFILING when compiling C++ sources with profiling Earlier, we used to pass all preprocessor flags to the c++ compiler. This meant that -DPROFILING was passed to the c++ compiler because it was a part of C++ flags However, this was incorrect and the behaviour was changed in 8ff3134ed4aa323b0199ad683f72165e51a59ab6. See #21291. But that commit exposed this bug where -DPROFILING was no longer being passed when compiling c++ sources. The fix is to explicitly include -DPROFILING in `opt_cxx` when profiling is enabled to ensure we pass the correct options for the way to both C and C++ compilers Fixes #24286 - - - - - 2cf9dd96 by Zubin Duggal at 2024-01-10T17:38:36-05:00 testsuite: rename objcpp -> objcxx To avoid confusion with C Pre Processsor - - - - - af6932d6 by Simon Peyton Jones at 2024-01-10T17:39:12-05:00 Make TYPE and CONSTRAINT not-apart Issue #24279 showed up a bug in the logic in GHC.Core.Unify.unify_ty which is supposed to make TYPE and CONSTRAINT be not-apart. Easily fixed. - - - - - 4a39b5ff by Zubin Duggal at 2024-01-10T17:39:48-05:00 ci: Fix typo in mk_ghcup_metadata.py There was a missing colon in the fix to #24268 in 989bf8e53c08eb22de716901b914b3607bc8dd08 - - - - - 13503451 by Zubin Duggal at 2024-01-10T17:40:24-05:00 release-ci: remove release-x86_64-linux-deb11-release+boot_nonmoving_gc job There is no reason to have this release build or distribute this variation. This configuration is for testing purposes only. - - - - - afca46a4 by Sebastian Graf at 2024-01-10T17:41:00-05:00 Parser: Add a Note detailing why we need happy's `error` to implement layout - - - - - eaf8a06d by Krzysztof Gogolewski at 2024-01-11T00:43:17+01:00 Turn -Wtype-equality-out-of-scope on by default Also remove -Wnoncanonical-{monoid,monad}-instances from -Wcompat, since they are enabled by default. Refresh wcompat-warnings/ test with new -Wcompat warnings. Part of #24267 Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - 42bee5aa by Sebastian Graf at 2024-01-12T21:16:21-05:00 Arity: Require called *exactly once* for eta exp with -fpedantic-bottoms (#24296) In #24296, we had a program in which we eta expanded away an error despite the presence of `-fpedantic-bottoms`. This was caused by turning called *at least once* lambdas into one-shot lambdas, while with `-fpedantic-bottoms` it is only sound to eta expand over lambdas that are called *exactly* once. An example can be found in `Note [Combining arity type with demand info]`. Fixes #24296. - - - - - 7e95f738 by Andreas Klebinger at 2024-01-12T21:16:57-05:00 Aarch64: Enable -mfma by default. Fixes #24311 - - - - - e43788d0 by Jason Shipman at 2024-01-14T12:47:38-05:00 Add more instances for Compose: Fractional, RealFrac, Floating, RealFloat CLC proposal #226 https://github.com/haskell/core-libraries-committee/issues/226 - - - - - ae6d8cd2 by Sebastian Graf at 2024-01-14T12:48:15-05:00 Pmc: COMPLETE pragmas associated with Family TyCons should apply to representation TyCons as well (#24326) Fixes #24326. - - - - - c5fc7304 by sheaf at 2024-01-15T14:15:29-05:00 Use lookupOccRn_maybe in TH.lookupName When looking up a value, we want to be able to find both variables and record fields. So we should not use the lookupSameOccRn_maybe function, as we can't know ahead of time which record field namespace a record field with the given textual name will belong to. Fixes #24293 - - - - - da908790 by Krzysztof Gogolewski at 2024-01-15T14:16:05-05:00 Make the build more strict on documentation errors * Detect undefined labels. This can be tested by adding :ref:`nonexistent` to a documentation rst file; attempting to build docs will fail. Fixed the undefined label in `9.8.1-notes.rst`. * Detect errors. While we have plenty of warnings, we can at least enforce that Sphinx does not report errors. Fixed the error in `required_type_arguments.rst`. Unrelated change: I have documented that the `-dlint` enables `-fcatch-nonexhaustive-cases`, as can be verified by checking `enableDLint`. - - - - - 5077416e by Javier Sagredo at 2024-01-16T15:40:06-05:00 Profiling: Adds an option to not start time profiling at startup Using the functionality provided by d89deeba47ce04a5198a71fa4cbc203fe2c90794, this patch creates a new rts flag `--no-automatic-time-samples` which disables the time profiling when starting a program. It is then expected that the user starts it whenever it is needed. Fixes #24337 - - - - - 5776008c by Matthew Pickering at 2024-01-16T15:40:42-05:00 eventlog: Fix off-by-one error in postIPE We were missing the extra_comma from the calculation of the size of the payload of postIPE. This was causing assertion failures when the event would overflow the buffer by one byte, as ensureRoomForVariable event would report there was enough space for `n` bytes but then we would write `n + 1` bytes into the buffer. Fixes #24287 - - - - - 66dc09b1 by Simon Peyton Jones at 2024-01-16T15:41:18-05:00 Improve SpecConstr (esp nofib/spectral/ansi) This MR makes three improvements to SpecConstr: see #24282 * It fixes an outright (and recently-introduced) bug in `betterPat`, which was wrongly forgetting to compare the lengths of the argument lists. * It enhances ConVal to inclue a boolean for work-free-ness, so that the envt can contain non-work-free constructor applications, so that we can do more: see Note [ConVal work-free-ness] * It rejigs `subsumePats` so that it doesn't reverse the list. This can make a difference because, when patterns overlap, we arbitrarily pick the first. There is no "right" way, but this retains the old pre-subsumePats behaviour, thereby "fixing" the regression in #24282. Nofib results +======================================== | spectral/ansi -21.14% | spectral/hartel/comp_lab_zift -0.12% | spectral/hartel/parstof +0.09% | spectral/last-piece -2.32% | spectral/multiplier +6.03% | spectral/para +0.60% | spectral/simple -0.26% +======================================== | geom mean -0.18% +---------------------------------------- The regression in `multiplier` is sad, but it simply replicates GHC's previous behaviour (e.g. GHC 9.6). - - - - - 65da79b3 by Matthew Pickering at 2024-01-16T15:41:54-05:00 hadrian: Reduce Cabal verbosity The comment claims that `simpleUserHooks` decrease verbosity, and it does, but only for the `postConf` phase. The other phases are too verbose with `-V`. At the moment > 5000 lines of the build log are devoted to output from `cabal copy`. So I take the simple approach and just decrease the verbosity level again. If the output of `postConf` is essential then it would be better to implement our own `UserHooks` which doesn't decrease the verbosity for `postConf`. Fixes #24338 - - - - - 16414d7d by Matthew Pickering at 2024-01-17T10:54:59-05:00 Stop retaining old ModGuts throughout subsequent simplifier phases Each phase of the simplifier typically rewrites the majority of ModGuts, so we want to be able to release the old ModGuts as soon as possible. `name_ppr_ctxt` lives throught the whole optimiser phase and it was retaining a reference to `ModGuts`, so we were failing to release the old `ModGuts` until the end of the phase (potentially doubling peak memory usage for that particular phase). This was discovered using eras profiling (#24332) Fixes #24328 - - - - - 7f0879e1 by Matthew Pickering at 2024-01-17T10:55:35-05:00 Update nofib submodule - - - - - 320454d3 by Cheng Shao at 2024-01-17T23:02:40+00:00 ci: bump ci-images for updated wasm image - - - - - 2eca52b4 by Cheng Shao at 2024-01-17T23:06:44+00:00 base: treat all FDs as "nonblocking" on wasm On posix platforms, when performing read/write on FDs, we check the nonblocking flag first. For FDs without this flag (e.g. stdout), we call fdReady() first, which in turn calls poll() to wait for I/O to be available on that FD. This is problematic for wasm32-wasi: although select()/poll() is supported via the poll_oneoff() wasi syscall, that syscall is rather heavyweight and runtime behavior differs in different wasi implementations. The issue is even worse when targeting browsers, given there's no satisfactory way to implement async I/O as a synchronous syscall, so existing JS polyfills for wasi often give up and simply return ENOSYS. Before we have a proper I/O manager that avoids poll_oneoff() for async I/O on wasm, this patch improves the status quo a lot by merely pretending all FDs are "nonblocking". Read/write on FDs will directly invoke read()/write(), which are much more reliably handled in existing wasi implementations, especially those in browsers. Fixes #23275 and the following test cases: T7773 isEOF001 openFile009 T4808 cgrun025 Approved by CLC proposal #234: https://github.com/haskell/core-libraries-committee/issues/234 - - - - - 83c6c710 by Andrew Lelechenko at 2024-01-18T05:21:49-05:00 base: clarify how to disable warnings about partiality of Data.List.{head,tail} - - - - - c4078f2f by Simon Peyton Jones at 2024-01-18T05:22:25-05:00 Fix four bug in handling of (forall cv. body_ty) These bugs are all described in #24335 It's not easy to provoke the bug, hence no test case. - - - - - 119586ea by Alexis King at 2024-01-19T00:08:00-05:00 Always refresh profiling CCSes after running pending initializers Fixes #24171. - - - - - 9718d970 by Oleg Grenrus at 2024-01-19T00:08:36-05:00 Set default-language: GHC2021 in ghc library Go through compiler/ sources, and remove all BangPatterns (and other GHC2021 enabled extensions in these files). - - - - - 3ef71669 by Matthew Pickering at 2024-01-19T21:55:16-05:00 testsuite: Remove unused have_library function Also remove the hence unused testsuite option `--test-package-db`. Fixes #24342 - - - - - 5b7fa20c by Jade at 2024-01-19T21:55:53-05:00 Fix Spelling in the compiler Tracking: #16591 - - - - - 09875f48 by Matthew Pickering at 2024-01-20T12:20:44-05:00 testsuite: Implement `isInTreeCompiler` in a more robust way Just a small refactoring to avoid redundantly specifying the same strings in two different places. - - - - - 0d12b987 by Jade at 2024-01-20T12:21:20-05:00 Change maintainer email from cvs-ghc at haskell.org to ghc-devs at haskell.org. Fixes #22142 - - - - - 1fa1c00c by Jade at 2024-01-23T19:17:03-05:00 Enhance Documentation of functions exported by Data.Function This patch aims to improve the documentation of functions exported in Data.Function Tracking: #17929 Fixes: #10065 - - - - - ab47a43d by Jade at 2024-01-23T19:17:39-05:00 Improve documentation of hGetLine. - Add explanation for whether a newline is returned - Add examples Fixes #14804 - - - - - dd4af0e5 by Cheng Shao at 2024-01-23T19:18:17-05:00 Fix genapply for cross-compilation by nuking fragile CPP logic This commit fixes incorrectly built genapply when cross compiling (#24347) by nuking all fragile CPP logic in it from the orbit. All target-specific info are now read from DerivedConstants.h at runtime, see added note for details. Also removes a legacy Makefile and adds haskell language server support for genapply. - - - - - 0cda2b8b by Cheng Shao at 2024-01-23T19:18:17-05:00 rts: enable wasm32 register mapping The wasm backend didn't properly make use of all Cmm global registers due to #24347. Now that it is fixed, this patch re-enables full register mapping for wasm32, and we can now generate smaller & faster wasm modules that doesn't always spill arguments onto the stack. Fixes #22460 #24152. - - - - - 0325a6e5 by Greg Steuck at 2024-01-24T01:29:44-05:00 Avoid utf8 in primops.txt.pp comments They don't make it through readFile' without explicitly setting the encoding. See https://gitlab.haskell.org/ghc/ghc/-/issues/17755 - - - - - 1aaf0bd8 by David Binder at 2024-01-24T01:30:20-05:00 Bump hpc and hpc-bin submodule Bump hpc to 0.7.0.1 Bump hpc-bin to commit d1780eb2 - - - - - e693a4e8 by Ben Gamari at 2024-01-24T01:30:56-05:00 testsuite: Ignore stderr in T8089 Otherwise spurious "Killed: 9" messages to stderr may cause the test to fail. Fixes #24361. - - - - - a40f4ab2 by sheaf at 2024-01-24T14:04:33-05:00 Fix FMA instruction on LLVM We were emitting the wrong instructions for fused multiply-add operations on LLVM: - the instruction name is "llvm.fma.f32" or "llvm.fma.f64", not "fmadd" - LLVM does not support other instructions such as "fmsub"; instead we implement these by flipping signs of some arguments - the instruction is an LLVM intrinsic, which requires handling it like a normal function call instead of a machine instruction Fixes #24223 - - - - - 69abc786 by Andrei Borzenkov at 2024-01-24T14:05:09-05:00 Add changelog entry for renaming tuples from (,,...,,) to Tuple<n> (24291) - - - - - 0ac8f385 by Cheng Shao at 2024-01-25T00:27:48-05:00 compiler: remove unused GHC.Linker module The GHC.Linker module is empty and unused, other than as a hack for the make build system. We can remove it now that make is long gone; the note is moved to GHC.Linker.Loader instead. - - - - - 699da01b by Hécate Moonlight at 2024-01-25T00:28:27-05:00 Clarification for newtype constructors when using `coerce` - - - - - b2d8cd85 by Matt Walker at 2024-01-26T09:50:08-05:00 Fix #24308 Add tests for semicolon separated where clauses - - - - - 0da490a1 by Ben Gamari at 2024-01-26T17:34:41-05:00 hsc2hs: Bump submodule - - - - - 3f442fd2 by Ben Gamari at 2024-01-26T17:34:41-05:00 Bump containers submodule to 0.7 - - - - - 82a1c656 by Sebastian Nagel at 2024-01-29T02:32:40-05:00 base: with{Binary}File{Blocking} only annotates own exceptions Fixes #20886 This ensures that inner, unrelated exceptions are not misleadingly annotated with the opened file. - - - - - 9294a086 by Andreas Klebinger at 2024-01-29T02:33:15-05:00 Fix fma warning when using llvm on aarch64. On aarch64 fma is always on so the +fma flag doesn't exist for that target. Hence no need to try and pass +fma to llvm. Fixes #24379 - - - - - ced2e731 by sheaf at 2024-01-29T17:27:12-05:00 No shadowing warnings for NoFieldSelector fields This commit ensures we don't emit shadowing warnings when a user shadows a field defined with NoFieldSelectors. Fixes #24381 - - - - - 8eeadfad by Patrick at 2024-01-29T17:27:51-05:00 Fix bug wrong span of nested_doc_comment #24378 close #24378 1. Update the start position of span in `nested_doc_comment` correctly. and hence the spans of identifiers of haddoc can be computed correctly. 2. add test `HaddockSpanIssueT24378`. - - - - - a557580f by Alexey Radkov at 2024-01-30T19:41:52-05:00 Fix irrelevant dodgy-foreign-imports warning on import f-pointers by value A test *сс018* is attached (not sure about the naming convention though). Note that without the fix, the test fails with the *dodgy-foreign-imports* warning passed to stderr. The warning disappears after the fix. GHC shouldn't warn on imports of natural function pointers from C by value (which is feasible with CApiFFI), such as ```haskell foreign import capi "cc018.h value f" f :: FunPtr (Int -> IO ()) ``` where ```c void (*f)(int); ``` See a related real-world use-case [here](https://gitlab.com/daniel-casanueva/pcre-light/-/merge_requests/17). There, GHC warns on import of C function pointer `pcre_free`. - - - - - ca99efaf by Alexey Radkov at 2024-01-30T19:41:53-05:00 Rename test cc018 -> T24034 - - - - - 88c38dd5 by Ben Gamari at 2024-01-30T19:42:28-05:00 rts/TraverseHeap.c: Ensure that PosixSource.h is included first - - - - - ca2e919e by Simon Peyton Jones at 2024-01-31T09:29:45+00:00 Make decomposeRuleLhs a bit more clever This fixes #24370 by making decomposeRuleLhs undertand dictionary /functions/ as well as plain /dictionaries/ - - - - - 94ce031d by Teo Camarasu at 2024-02-01T05:49:49-05:00 doc: Add -Dn flag to user guide Resolves #24394 - - - - - 31553b11 by Ben Gamari at 2024-02-01T12:21:29-05: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. - - - - - 0785cf81 by Ben Gamari at 2024-02-01T12:21:29-05:00 codeGen: Use relaxed accesses in ticky bumping - - - - - be423dda by Ben Gamari at 2024-02-01T12:21:29-05:00 base: use atomic write when updating timer manager - - - - - 8a310e35 by Ben Gamari at 2024-02-01T12:21:29-05:00 Use relaxed atomics to manipulate TSO status fields - - - - - d6809ee4 by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Add necessary barriers when manipulating TSO owner - - - - - 39e3ac5d by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Use `switch` to branch on why_blocked This is a semantics-preserving refactoring. - - - - - 515eb33d by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix synchronization on thread blocking state We now use a release barrier whenever we update a thread's blocking state. This required widening StgTSO.why_blocked as AArch64 does not support atomic writes on 16-bit values. - - - - - eb38812e by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS and only needs relaxed ordering. - - - - - 26c48dd6 by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix data race in threadStatus# - - - - - 6af43ab4 by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix data race in Interpreter's preemption check - - - - - 9502ad3c by Ben Gamari at 2024-02-01T12:21:29-05:00 rts/Messages: Fix data race - - - - - 60802db5 by Ben Gamari at 2024-02-01T12:21:30-05:00 rts/Prof: Fix data race - - - - - ef8ccef5 by Ben Gamari at 2024-02-01T12:21:30-05:00 rts: Use relaxed ordering on dirty/clean info tables updates When changing the dirty/clean state of a mutable object we needn't have any particular ordering. - - - - - 76fe2b75 by Ben Gamari at 2024-02-01T12:21:30-05:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - a6316eb4 by Ben Gamari at 2024-02-01T12:21:30-05:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 6bddfd3d by Ben Gamari at 2024-02-01T12:21:30-05:00 rts: Use fence rather than redundant load Previously we would use an atomic load to ensure acquire ordering. However, we now have `ACQUIRE_FENCE_ON`, which allows us to express this more directly. - - - - - 55c65dbc by Ben Gamari at 2024-02-01T12:21:30-05:00 rts: Fix data races in profiling timer - - - - - 856b5e75 by Ben Gamari at 2024-02-01T12:21:30-05:00 Add Note [C11 memory model] - - - - - 6534da24 by Cheng Shao at 2024-02-01T12:22:07-05:00 compiler: move generic cmm optimization logic in NCG to a standalone module This commit moves GHC.CmmToAsm.cmmToCmm to a standalone module, GHC.Cmm.GenericOpt. The main motivation is enabling this logic to be run in the wasm backend NCG code, which is defined in other modules that's imported by GHC.CmmToAsm, causing a cyclic dependency issue. - - - - - 87e34888 by Cheng Shao at 2024-02-01T12:22:07-05:00 compiler: explicitly disable PIC in wasm32 NCG This commit explicitly disables the ncgPIC flag for the wasm32 target. The wasm backend doesn't support PIC for the time being. - - - - - c6ce242e by Cheng Shao at 2024-02-01T12:22:07-05:00 compiler: enable generic cmm optimizations in wasm backend NCG This commit enables the generic cmm optimizations in other NCGs to be run in the wasm backend as well, followed by a late cmm control-flow optimization pass. The added optimizations do catch some corner cases not handled by the pre-NCG cmm pipeline and are useful in generating smaller CFGs. - - - - - 151dda4e by Andrei Borzenkov at 2024-02-01T12:22:43-05:00 Namespacing for WARNING/DEPRECATED pragmas (#24396) New syntax for WARNING and DEPRECATED pragmas was added, namely namespace specifierss: namespace_spec ::= 'type' | 'data' | {- empty -} warning ::= warning_category namespace_spec namelist strings deprecation ::= namespace_spec namelist strings A new data type was introduced to represent these namespace specifiers: data NamespaceSpecifier = NoSpecifier | TypeNamespaceSpecifier (EpToken "type") | DataNamespaceSpecifier (EpToken "data") Extension field XWarning now contains this NamespaceSpecifier. lookupBindGroupOcc function was changed: it now takes NamespaceSpecifier and checks that the namespace of the found names matches the passed flag. With this change {-# WARNING data D "..." #-} pragma will only affect value namespace and {-# WARNING type D "..." #-} will only affect type namespace. The same logic is applicable to DEPRECATED pragmas. Finding duplicated warnings inside rnSrcWarnDecls now takes into consideration NamespaceSpecifier flag to allow warnings with the same names that refer to different namespaces. - - - - - 38c3afb6 by Bryan Richter at 2024-02-01T12:23:19-05:00 CI: Disable the test-cabal-reinstall job Fixes #24363 - - - - - 27020458 by Matthew Craven at 2024-02-03T01:53:26-05:00 Bump bytestring submodule to something closer to 0.12.1 ...mostly so that 16d6b7e835ffdcf9b894e79f933dd52348dedd0c (which reworks unaligned writes in Builder) and the stuff in https://github.com/haskell/bytestring/pull/631 can see wider testing. The less-terrible code for unaligned writes used in Builder on hosts not known to be ulaigned-friendly also takes less effort for GHC to compile, resulting in a metric decrease for T21839c on some platforms. The metric increase on T21839r is caused by the unrelated commit 750dac33465e7b59100698a330b44de7049a345c. It perhaps warrants further analysis and discussion (see #23822) but is not critical. Metric Decrease: T21839c Metric Increase: T21839r - - - - - cdddeb0f by Rodrigo Mesquita at 2024-02-03T01:54:02-05:00 Work around autotools setting C11 standard in CC/CXX In autoconf >=2.70, C11 is set by default for $CC and $CXX via the -std=...11 flag. In this patch, we split the "-std" flag out of the $CC and $CXX variables, which we traditionally assume to be just the executable name/path, and move it to $CFLAGS/$CXXFLAGS instead. Fixes #24324 - - - - - 5ff7cc26 by Apoorv Ingle at 2024-02-03T13:14:46-06:00 Expand `do` blocks right before typechecking using the `HsExpansion` philosophy. - Fixes #18324 #20020 #23147 #22788 #15598 #22086 #21206 - The change is detailed in - Note [Expanding HsDo with HsExpansion] in `GHC.Tc.Gen.Do` - Note [Doing HsExpansion in the Renamer vs Typechecker] in `GHC.Rename.Expr` expains the rational of doing expansions in type checker as opposed to in the renamer - Adds new datatypes: - `GHC.Hs.Expr.XXExprGhcRn`: new datatype makes this expansion work easier 1. Expansion bits for Expressions, Statements and Patterns in (`ExpandedThingRn`) 2. `PopErrCtxt` a special GhcRn Phase only artifcat to pop the previous error message in the error context stack - `GHC.Basic.Origin` now tracks the reason for expansion in case of Generated This is useful for type checking cf. `GHC.Tc.Gen.Expr.tcExpr` case for `HsLam` - Kills `HsExpansion` and `HsExpanded` as we have inlined them in `XXExprGhcRn` and `XXExprGhcTc` - Ensures warnings such as 1. Pattern match checks 2. Failable patterns 3. non-() return in body statements are preserved - Kill `HsMatchCtxt` in favor of `TcMatchAltChecker` - Testcases: * T18324 T20020 T23147 T22788 T15598 T22086 * T23147b (error message check), * DoubleMatch (match inside a match for pmc check) * pattern-fails (check pattern match with non-refutable pattern, eg. newtype) * Simple-rec (rec statements inside do statment) * T22788 (code snippet from #22788) * DoExpanion1 (Error messages for body statments) * DoExpansion2 (Error messages for bind statements) * DoExpansion3 (Error messages for let statements) Also repoint haddock to the right submodule so that the test (haddockHypsrcTest) pass Metric Increase 'compile_time/bytes allocated': T9020 The testcase is a pathalogical example of a `do`-block with many statements that do nothing. Given that we are expanding the statements into function binds, we will have to bear a (small) 2% cost upfront in the compiler to unroll the statements. - - - - - 0df8ce27 by Vladislav Zavialov at 2024-02-04T03:55:14-05:00 Reduce parser allocations in allocateCommentsP In the most common case, the comment queue is empty, so we can skip the work of processing it. This reduces allocations by about 10% in the parsing001 test. Metric Decrease: MultiLayerModulesRecomp parsing001 - - - - - cfd68290 by Simon Peyton Jones at 2024-02-05T17:58:33-05:00 Stop dropping a case whose binder is demanded This MR fixes #24251. See Note [Case-to-let for strictly-used binders] in GHC.Core.Opt.Simplify.Iteration, plus #24251, for lots of discussion. Final Nofib changes over 0.1%: +----------------------------------------- | imaginary/digits-of-e2 -2.16% | imaginary/rfib -0.15% | real/fluid -0.10% | real/gamteb -1.47% | real/gg -0.20% | real/maillist +0.19% | real/pic -0.23% | real/scs -0.43% | shootout/n-body -0.41% | shootout/spectral-norm -0.12% +======================================== | geom mean -0.05% Pleasingly, overall executable size is down by just over 1%. Compile times (in perf/compiler) wobble around a bit +/- 0.5%, but the geometric mean is -0.1% which seems good. - - - - - e4d137bb by Simon Peyton Jones at 2024-02-05T17:58:33-05:00 Add Note [Bangs in Integer functions] ...to document the bangs in the functions in GHC.Num.Integer - - - - - ce90f12f by Andrei Borzenkov at 2024-02-05T17:59:09-05:00 Hide WARNING/DEPRECATED namespacing under -XExplicitNamespaces (#24396) - - - - - e2ea933f by Simon Peyton Jones at 2024-02-06T10:12:04-05:00 Refactoring in preparation for lazy skolemisation * Make HsMatchContext and HsStmtContext be parameterised over the function name itself, rather than over the pass. See [mc_fun field of FunRhs] in Language.Haskell.Syntax.Expr - Replace types HsMatchContext GhcPs --> HsMatchContextPs HsMatchContext GhcRn --> HsMatchContextRn HsMatchContext GhcTc --> HsMatchContextRn (sic! not Tc) HsStmtContext GhcRn --> HsStmtContextRn - Kill off convertHsMatchCtxt * Split GHC.Tc.Type.BasicTypes.TcSigInfo so that TcCompleteSig (describing a complete user-supplied signature) is its own data type. - Split TcIdSigInfo(CompleteSig, PartialSig) into TcCompleteSig(CSig) TcPartialSig(PSig) - Use TcCompleteSig in tcPolyCheck, CheckGen - Rename types and data constructors: TcIdSigInfo --> TcIdSig TcPatSynInfo(TPSI) --> TcPatSynSig(PatSig) - Shuffle around helper functions: tcSigInfoName (moved to GHC.Tc.Types.BasicTypes) completeSigPolyId_maybe (moved to GHC.Tc.Types.BasicTypes) tcIdSigName (inlined and removed) tcIdSigLoc (introduced) - Rearrange the pattern match in chooseInferredQuantifiers * Rename functions and types: tcMatchesCase --> tcCaseMatches tcMatchesFun --> tcFunBindMatches tcMatchLambda --> tcLambdaMatches tcPats --> tcMatchPats matchActualFunTysRho --> matchActualFunTys matchActualFunTySigma --> matchActualFunTy * Add HasDebugCallStack constraints to: mkBigCoreVarTupTy, mkBigCoreTupTy, boxTy, mkPiTy, mkPiTys, splitAppTys, splitTyConAppNoView_maybe * Use `penv` from the outer context in the inner loop of GHC.Tc.Gen.Pat.tcMultiple * Move tcMkVisFunTy, tcMkInvisFunTy, tcMkScaledFunTys down the file, factor out and export tcMkScaledFunTy. * Move isPatSigCtxt down the file. * Formatting and comments Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - f5d3e03c by Andrei Borzenkov at 2024-02-06T10:12:04-05:00 Lazy skolemisation for @a-binders (#17594) This patch is a preparation for @a-binders implementation. The main changes are: * Skolemisation is now prepared to deal with @binders. See Note [Skolemisation overview] in GHC.Tc.Utils.Unify. Most of the action is in - Utils.Unify.matchExpectedFunTys - Gen.Pat.tcMatchPats - Gen.Expr.tcPolyExprCheck - Gen.Binds.tcPolyCheck Some accompanying refactoring: * I found that funTyConAppTy_maybe was doing a lot of allocation, and rejigged userTypeError_maybe to avoid calling it. - - - - - 532993c8 by Zubin Duggal at 2024-02-06T10:12:41-05:00 driver: Really don't lose track of nodes when we fail to resolve cycles This fixes a bug in 8db8d2fd1c881032b1b360c032b6d9d072c11723, where we could lose track of acyclic components at the start of an unresolved cycle. We now ensure we never loose track of any of these components. As T24275 demonstrates, a "cyclic" SCC might not really be a true SCC: When viewed without boot files, we have a single SCC ``` [REC main:T24275B [main:T24275B {-# SOURCE #-}, main:T24275A {-# SOURCE #-}] main:T24275A [main:T24275A {-# SOURCE #-}]] ``` But with boot files this turns into ``` [NONREC main:T24275B {-# SOURCE #-} [], REC main:T24275B [main:T24275B {-# SOURCE #-}, main:T24275A {-# SOURCE #-}] main:T24275A {-# SOURCE #-} [main:T24275B], NONREC main:T24275A [main:T24275A {-# SOURCE #-}]] ``` Note that this is truly not an SCC, as no nodes are reachable from T24275B.hs-boot. However, we treat this entire group as a single "SCC" because it seems so when we analyse the graph without taking boot files into account. Indeed, we must return a single ResolvedCycle element in the BuildPlan for this as described in Note [Upsweep]. However, since after resolving this is not a true SCC anymore, `findCycle` fails to find a cycle and we have a sub-optimal error message as a result. To handle this, I extended `findCycle` to not assume its input is an SCC, and to try harder to find cycles in its input. Fixes #24275 - - - - - b35dd613 by Zubin Duggal at 2024-02-06T10:13:17-05:00 GHCi: Lookup breakpoint CCs in the correct module We need to look up breakpoint CCs in the module that the breakpoint points to, and not the current module. Fixes #24327 - - - - - b09e6958 by Zubin Duggal at 2024-02-06T10:13:17-05:00 testsuite: Add test for #24327 - - - - - 569b4c10 by doyougnu at 2024-02-07T03:06:26-05:00 ts: add compile_artifact, ignore_extension flag In b521354216f2821e00d75f088d74081d8b236810 the testsuite gained the capability to collect generic metrics. But this assumed that the test was not linking and producing artifacts and we only wanted to track object files, interface files, or build artifacts from the compiler build. However, some backends, such as the JS backend, produce artifacts when compiling, such as the jsexe directory which we want to track. This patch: - tweaks the testsuite to collect generic metrics on any build artifact in the test directory. - expands the exe_extension function to consider windows and adds the ignore_extension flag. - Modifies certain tests to add the ignore_extension flag. Tests such as heaprof002 expect a .ps file, but on windows without ignore_extensions the testsuite will look for foo.exe.ps. Hence the flag. - adds the size_hello_artifact test - - - - - 75a31379 by doyougnu at 2024-02-07T03:06:26-05:00 ts: add wasm_arch, heapprof002 wasm extension - - - - - c9731d6d by Rodrigo Mesquita at 2024-02-07T03:07:03-05:00 Synchronize bindist configure for #24324 In cdddeb0f1280b40cc194028bbaef36e127175c4c, we set up a workaround for #24324 in the in-tree configure script, but forgot to update the bindist configure script accordingly. This updates it. - - - - - d309f4e7 by Matthew Pickering at 2024-02-07T03:07:38-05:00 distrib/configure: Fix typo in CONF_GCC_LINKER_OPTS_STAGE2 variable Instead we were setting CONF_GCC_LINK_OPTS_STAGE2 which meant that we were missing passing `--target` when invoking the linker. Fixes #24414 - - - - - 77db84ab by Ben Gamari at 2024-02-08T00:35:22-05:00 llvmGen: Adapt to allow use of new pass manager. We now must use `-passes` in place of `-O<n>` due to #21936. Closes #21936. - - - - - 3c9ddf97 by Matthew Pickering at 2024-02-08T00:35:59-05:00 testsuite: Mark length001 as fragile on javascript Modifying the timeout multiplier is not a robust way to get this test to reliably fail. Therefore we mark it as fragile until/if javascript ever supports the stack limit. - - - - - 20b702b5 by Matthew Pickering at 2024-02-08T00:35:59-05:00 Javascript: Don't filter out rtsDeps list This logic appears to be incorrect as it would drop any dependency which was not in a direct dependency of the package being linked. In the ghc-internals split this started to cause errors because `ghc-internal` is not a direct dependency of most packages, and hence important symbols to keep which are hard coded into the js runtime were getting dropped. - - - - - 2df96366 by Ben Gamari at 2024-02-08T00:35:59-05:00 base: Cleanup whitespace in cbits - - - - - 44f6557a by Ben Gamari at 2024-02-08T00:35:59-05:00 Move `base` to `ghc-internal` Here we move a good deal of the implementation of `base` into a new package, `ghc-internal` such that it can be evolved independently from the user-visible interfaces of `base`. While we want to isolate implementation from interfaces, naturally, we would like to avoid turning `base` into a mere set of module re-exports. However, this is a non-trivial undertaking for a variety of reasons: * `base` contains numerous known-key and wired-in things, requiring corresponding changes in the compiler * `base` contains a significant amount of C code and corresponding autoconf logic, which is very fragile and difficult to break apart * `base` has numerous import cycles, which are currently dealt with via carefully balanced `hs-boot` files * We must not break existing users To accomplish this migration, I tried the following approaches: * [Split-GHC.Base]: Break apart the GHC.Base knot to allow incremental migration of modules into ghc-internal: this knot is simply too intertwined to be easily pulled apart, especially given the rather tricky import cycles that it contains) * [Move-Core]: Moving the "core" connected component of base (roughly 150 modules) into ghc-internal. While the Haskell side of this seems tractable, the C dependencies are very subtle to break apart. * [Move-Incrementally]: 1. Move all of base into ghc-internal 2. Examine the module structure and begin moving obvious modules (e.g. leaves of the import graph) back into base 3. Examine the modules remaining in ghc-internal, refactor as necessary to facilitate further moves 4. Go to (2) iterate until the cost/benefit of further moves is insufficient to justify continuing 5. Rename the modules moved into ghc-internal to ensure that they don't overlap with those in base 6. For each module moved into ghc-internal, add a shim module to base with the declarations which should be exposed and any requisite Haddocks (thus guaranteeing that base will be insulated from changes in the export lists of modules in ghc-internal Here I am using the [Move-Incrementally] approach, which is empirically the least painful of the unpleasant options above Bumps haddock submodule. Metric Decrease: haddock.Cabal haddock.base Metric Increase: MultiComponentModulesRecomp T16875 size_hello_artifact - - - - - e8fb2451 by Vladislav Zavialov at 2024-02-08T00:36:36-05:00 Haddock comments on infix constructors (#24221) Rewrite the `HasHaddock` instance for `ConDecl GhcPs` to account for infix constructors. This change fixes a Haddock regression (introduced in 19e80b9af252) that affected leading comments on infix data constructor declarations: -- | Docs for infix constructor | Int :* Bool The comment should be associated with the data constructor (:*), not with its left-hand side Int. - - - - - 9060d55b by Ben Gamari at 2024-02-08T00:37:13-05:00 Add os-string as a boot package Introduces `os-string` submodule. This will be necessary for `filepath-1.5`. - - - - - 9d65235a by Ben Gamari at 2024-02-08T00:37:13-05:00 gitignore: Ignore .hadrian_ghci_multi/ - - - - - d7ee12ea by Ben Gamari at 2024-02-08T00:37:13-05:00 hadrian: Set -this-package-name When constructing the GHC flags for a package Hadrian must take care to set `-this-package-name` in addition to `-this-unit-id`. This hasn't broken until now as we have not had any uses of qualified package imports. However, this will change with `filepath-1.5` and the corresponding `unix` bump, breaking `hadrian/multi-ghci`. - - - - - f2dffd2e by Ben Gamari at 2024-02-08T00:37:13-05:00 Bump filepath to 1.5.0.0 Required bumps of the following submodules: * `directory` * `filepath` * `haskeline` * `process` * `unix` * `hsc2hs` * `Win32` * `semaphore-compat` and the addition of `os-string` as a boot package. - - - - - ab533e71 by Matthew Pickering at 2024-02-08T00:37:50-05:00 Use specific clang assembler when compiling with -fllvm There are situations where LLVM will produce assembly which older gcc toolchains can't handle. For example on Deb10, it seems that LLVM >= 13 produces assembly which the default gcc doesn't support. A more robust solution in the long term is to require a specific LLVM compatible assembler when using -fllvm. Fixes #16354 - - - - - c32b6426 by Matthew Pickering at 2024-02-08T00:37:50-05:00 Update CI images with LLVM 15, ghc-9.6.4 and cabal-install-3.10.2.0 - - - - - 5fcd58be by Matthew Pickering at 2024-02-08T00:37:50-05:00 Update bootstrap plans for 9.4.8 and 9.6.4 - - - - - 707a32f5 by Matthew Pickering at 2024-02-08T00:37:50-05:00 Add alpine 3_18 release job This is mainly experimental and future proofing to enable a smooth transition to newer alpine releases once 3_12 is too old. - - - - - c37931b3 by John Ericson at 2024-02-08T06:39:05-05:00 Generate LLVM min/max bound policy via Hadrian Per #23966, I want the top-level configure to only generate configuration data for Hadrian, not do any "real" tasks on its own. This is part of that effort --- one less file generated by it. (It is still done with a `.in` file, so in a future world non-Hadrian also can easily create this file.) Split modules: - GHC.CmmToLlvm.Config - GHC.CmmToLlvm.Version - GHC.CmmToLlvm.Version.Bounds - GHC.CmmToLlvm.Version.Type This also means we can get rid of the silly `unused.h` introduced in !6803 / 7dfcab2f4bcb7206174ea48857df1883d05e97a2 as temporary kludge. Part of #23966 - - - - - 9f987235 by Apoorv Ingle at 2024-02-08T06:39:42-05:00 Enable mdo statements to use HsExpansions Fixes: #24411 Added test T24411 for regression - - - - - 762b2120 by Jade at 2024-02-08T15:17:15+00:00 Improve Monad, Functor & Applicative docs This patch aims to improve the documentation of Functor, Applicative, Monad and related symbols. The main goal is to make it more consistent and make accessible. See also: !10979 (closed) and !10985 (closed) Ticket #17929 Updates haddock submodule - - - - - 151770ca by Josh Meredith at 2024-02-10T14:28:15-05:00 JavaScript codegen: Use GHC's tag inference where JS backend-specific evaluation inference was previously used (#24309) - - - - - 2e880635 by Zubin Duggal at 2024-02-10T14:28:51-05:00 ci: Allow release-hackage-lint to fail Otherwise it blocks the ghcup metadata pipeline from running. - - - - - b0293f78 by Matthew Pickering at 2024-02-10T14:29:28-05:00 rts: eras profiling mode The eras profiling mode is useful for tracking the life-time of closures. When a closure is written, the current era is recorded in the profiling header. This records the era in which the closure was created. * Enable with -he * User mode: Use functions ghc-experimental module GHC.Profiling.Eras to modify the era * Automatically: --automatic-era-increment, increases the user era on major collections * The first era is era 1 * -he<era> can be used with other profiling modes to select a specific era If you just want to record the era but not to perform heap profiling you can use `-he --no-automatic-heap-samples`. https://well-typed.com/blog/2024/01/ghc-eras-profiling/ Fixes #24332 - - - - - be674a2c by Jade at 2024-02-10T14:30:04-05:00 Adjust error message for trailing whitespace in as-pattern. Fixes #22524 - - - - - 53ef83f9 by doyougnu at 2024-02-10T14:30:47-05:00 gitlab: js: add codeowners Fixes: - #24409 Follow on from: - #21078 and MR !9133 - When we added the JS backend this was forgotten. This patch adds the rightful codeowners. - - - - - 8bbe12f2 by Matthew Pickering at 2024-02-10T14:31:23-05:00 Bump CI images so that alpine3_18 image includes clang15 The only changes here are that clang15 is now installed on the alpine-3_18 image. - - - - - df9fd9f7 by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: handle stored null StablePtr Some Haskell codes unsafely cast StablePtr into ptr to compare against NULL. E.g. in direct-sqlite: if castStablePtrToPtr aggStPtr /= nullPtr then where `aggStPtr` is read (`peek`) from zeroed memory initially. We fix this by giving these StablePtr the same representation as other null pointers. It's safe because StablePtr at offset 0 is unused (for this exact reason). - - - - - 55346ede by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: disable MergeObjsMode test This isn't implemented for JS backend objects. - - - - - aef587f6 by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: add support for linking C sources Support linking C sources with JS output of the JavaScript backend. See the added documentation in the users guide. The implementation simply extends the JS linker to use the objects (.o) that were already produced by the emcc compiler and which were filtered out previously. I've also added some options to control the link with C functions (see the documentation about pragmas). With this change I've successfully compiled the direct-sqlite package which embeds the sqlite.c database code. Some wrappers are still required (see the documentation about wrappers) but everything generic enough to be reused for other libraries have been integrated into rts/js/mem.js. - - - - - b71b392f by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: avoid EMCC logging spurious failure emcc would sometime output messages like: cache:INFO: generating system asset: symbol_lists/424b44514e43d789148e69e4e7d1c7fdc0350b79.json... (this will be cached in "/emsdk/upstream/emscripten/cache/symbol_lists/424b44514e43d789148e69e4e7d1c7fdc0350b79.json" for subsequent builds) cache:INFO: - ok Cf https://github.com/emscripten-core/emscripten/issues/18607 This breaks our tests matching the stderr output. We avoid this by setting EMCC_LOGGING=0 - - - - - ff2c0cc9 by Simon Peyton Jones at 2024-02-12T12:19:17-05:00 Remove a dead comment Just remove an out of date block of commented-out code, and tidy up the relevant Notes. See #8317. - - - - - bedb4f0d by Teo Camarasu at 2024-02-12T18:50:33-05:00 nonmoving: Add support for heap profiling Add support for heap profiling while using the nonmoving collector. We greatly simply the implementation by disabling concurrent collection for GCs when heap profiling is enabled. This entails that the marked objects on the nonmoving heap are exactly the live objects. Note that we match the behaviour for live bytes accounting by taking the size of objects on the nonmoving heap to be that of the segment's block rather than the object itself. Resolves #22221 - - - - - d0d5acb5 by Teo Camarasu at 2024-02-12T18:51:09-05:00 doc: Add requires prof annotation to options that require it Resolves #24421 - - - - - 57bb8c92 by Cheng Shao at 2024-02-13T14:07:49-05:00 deriveConstants: add needed constants for wasm backend This commit adds needed constants to deriveConstants. They are used by RTS code in the wasm backend to support the JSFFI logic. - - - - - 615eb855 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms The pure Haskell implementation causes i386 regression in unrelated work that can be fixed by using C-based atomic increment, see added comment for details. - - - - - a9918891 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: allow JSFFI for wasm32 This commit allows the javascript calling convention to be used when the target platform is wasm32. - - - - - 8771a53b by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: allow boxed JSVal as a foreign type This commit allows the boxed JSVal type to be used as a foreign argument/result type. - - - - - 053c92b3 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: ensure ctors have the right priority on wasm32 This commit fixes the priorities of ctors generated by GHC codegen on wasm32, see the referred note for details. - - - - - b7942e0a by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: add JSFFI desugar logic for wasm32 This commit adds JSFFI desugar logic for the wasm backend. - - - - - 2c1dca76 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: add JavaScriptFFI to supported extension list on wasm32 This commit adds JavaScriptFFI as a supported extension when the target platform is wasm32. - - - - - 9ad0e2b4 by Cheng Shao at 2024-02-13T14:07:49-05:00 rts/ghc-internal: add JSFFI support logic for wasm32 This commit adds rts/ghc-internal logic to support the wasm backend's JSFFI functionality. - - - - - e9ebea66 by Cheng Shao at 2024-02-13T14:07:49-05:00 ghc-internal: fix threadDelay for wasm in browsers This commit fixes broken threadDelay for wasm when it runs in browsers, see added note for detailed explanation. - - - - - f85f3fdb by Cheng Shao at 2024-02-13T14:07:49-05:00 utils: add JSFFI utility code This commit adds JavaScript util code to utils to support the wasm backend's JSFFI functionality: - jsffi/post-link.mjs, a post-linker to process the linked wasm module and emit a small complement JavaScript ESM module to be used with it at runtime - jsffi/prelude.js, a tiny bit of prelude code as the JavaScript side of runtime logic - jsffi/test-runner.mjs, run the jsffi test cases Co-authored-by: amesgen <amesgen at amesgen.de> - - - - - 77e91500 by Cheng Shao at 2024-02-13T14:07:49-05:00 hadrian: distribute jsbits needed for wasm backend's JSFFI support The post-linker.mjs/prelude.js files are now distributed in the bindist libdir, so when using the wasm backend's JSFFI feature, the user wouldn't need to fetch them from a ghc checkout manually. - - - - - c47ba1c3 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: add opts.target_wrapper This commit adds opts.target_wrapper which allows overriding the target wrapper on a per test case basis when testing a cross target. This is used when testing the wasm backend's JSFFI functionality; the rest of the cases are tested using wasmtime, though the jsffi cases are tested using the node.js based test runner. - - - - - 8e048675 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: T22774 should work for wasm JSFFI T22774 works since the wasm backend now supports the JSFFI feature. - - - - - 1d07f9a6 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: add JSFFI test cases for wasm backend This commit adds a few test cases for the wasm backend's JSFFI functionality, as well as a simple README to instruct future contributors to add new test cases. - - - - - b8997080 by Cheng Shao at 2024-02-13T14:07:49-05:00 docs: add documentation for wasm backend JSFFI This commit adds changelog and user facing documentation for the wasm backend's JSFFI feature. - - - - - ffeb000d by David Binder at 2024-02-13T14:08:30-05:00 Add tests from libraries/process/tests and libraries/Win32/tests to GHC These tests were previously part of the libraries, which themselves are submodules of the GHC repository. This commit moves the tests directly to the GHC repository. - - - - - 5a932cf2 by David Binder at 2024-02-13T14:08:30-05:00 Do not execute win32 tests on non-windows runners - - - - - 500d8cb8 by Jade at 2024-02-13T14:09:07-05:00 prevent GHCi (and runghc) from suggesting other symbols when not finding main Fixes: #23996 - - - - - b19ec331 by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: update xxHash to v0.8.2 - - - - - 4a97bdb8 by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: use XXH3_64bits hash on all 64-bit platforms This commit enables XXH3_64bits hash to be used on all 64-bit platforms. Previously it was only enabled on x86_64, so platforms like aarch64 silently falls back to using XXH32 which degrades the hashing function quality. - - - - - ee01de7d by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: define XXH_INLINE_ALL This commit cleans up how we include the xxhash.h header and only define XXH_INLINE_ALL, which is sufficient to inline the xxHash functions without symbol collision. - - - - - 0e01e1db by Alan Zimmerman at 2024-02-14T02:13:22-05:00 EPA: Move EpAnn out of extension points Leaving a few that are too tricky, maybe some other time. Also - remove some unneeded helpers from Parser.y - reduce allocations with strictness annotations Updates haddock submodule Metric Decrease: parsing001 - - - - - de589554 by Andreas Klebinger at 2024-02-14T02:13:59-05:00 Fix ffi callbacks with >6 args and non-64bit args. Check for ptr/int arguments rather than 64-bit width arguments when counting integer register arguments. The old approach broke when we stopped using exclusively W64-sized types to represent sub-word sized integers. Fixes #24314 - - - - - 325b7613 by Ben Gamari at 2024-02-14T14:27:45-05:00 rts/EventLog: Place eliminate duplicate strlens Previously many of the `post*` implementations would first compute the length of the event's strings in order to determine the event length. Later we would then end up computing the length yet again in `postString`. Now we instead pass the string length to `postStringLen`, avoiding the repeated work. - - - - - 8aafa51c by Ben Gamari at 2024-02-14T14:27:46-05:00 rts/eventlog: Place upper bound on IPE string field lengths The strings in IPE events may be of unbounded length. Limit the lengths of these fields to 64k characters to ensure that we don't exceed the maximum event length. - - - - - 0e60d52c by Zubin Duggal at 2024-02-14T14:27:46-05:00 rts: drop unused postString function - - - - - d8d1333a by Cheng Shao at 2024-02-14T14:28:23-05:00 compiler/rts: fix wasm unreg regression This commit fixes two wasm unreg regressions caught by a nightly pipeline: - Unknown stg_scheduler_loopzh symbol when compiling scheduler.cmm - Invalid _hs_constructor(101) function name when handling ctor - - - - - 264a4fa9 by Owen Shepherd at 2024-02-15T09:41:06-05:00 feat: Add sortOn to Data.List.NonEmpty Adds `sortOn` to `Data.List.NonEmpty`, and adds comments describing when to use it, compared to `sortWith` or `sortBy . comparing`. The aim is to smooth out the API between `Data.List`, and `Data.List.NonEmpty`. This change has been discussed in the [clc issue](https://github.com/haskell/core-libraries-committee/issues/227). - - - - - b57200de by Fendor at 2024-02-15T09:41:47-05:00 Prefer RdrName over OccName for looking up locations in doc renaming step Looking up by OccName only does not take into account when functions are only imported in a qualified way. Fixes issue #24294 Bump haddock submodule to include regression test - - - - - 8ad02724 by Luite Stegeman at 2024-02-15T17:33:32-05:00 JS: add simple optimizer The simple optimizer reduces the size of the code generated by the JavaScript backend without the complexity and performance penalty of the optimizer in GHCJS. Also see #22736 Metric Decrease: libdir size_hello_artifact - - - - - 20769b36 by Matthew Pickering at 2024-02-15T17:34:07-05:00 base: Expose `--no-automatic-time-samples` in `GHC.RTS.Flags` API This patch builds on 5077416e12cf480fb2048928aa51fa4c8fc22cf1 and modifies the base API to reflect the new RTS flag. CLC proposal #243 - https://github.com/haskell/core-libraries-committee/issues/243 Fixes #24337 - - - - - 08031ada by Teo Camarasu at 2024-02-16T13:37:00-05:00 base: export System.Mem.performBlockingMajorGC The corresponding C function was introduced in ba73a807edbb444c49e0cf21ab2ce89226a77f2e. As part of #22264. Resolves #24228 The CLC proposal was disccused at: https://github.com/haskell/core-libraries-committee/issues/230 Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 1f534c2e by Florian Weimer at 2024-02-16T13:37:42-05:00 Fix C output for modern C initiative GCC 14 on aarch64 rejects the C code written by GHC with this kind of error: error: assignment to ‘ffi_arg’ {aka ‘long unsigned int’} from ‘HsPtr’ {aka ‘void *’} makes integer from pointer without a cast [-Wint-conversion] 68 | *(ffi_arg*)resp = cret; | ^ Add the correct cast. For more information on this see: https://fedoraproject.org/wiki/Changes/PortingToModernC Tested-by: Richard W.M. Jones <rjones at redhat.com> - - - - - 5d3f7862 by Matthew Craven at 2024-02-16T13:38:18-05:00 Bump bytestring submodule to 0.12.1.0 - - - - - 902ebcc2 by Ian-Woo Kim at 2024-02-17T06:01:01-05:00 Add missing BCO handling in scavenge_one. - - - - - 97d26206 by Sylvain Henry at 2024-02-17T06:01:44-05:00 Make cast between words and floats real primops (#24331) First step towards fixing #24331. Replace foreign prim imports with real primops. - - - - - a40e4781 by Sylvain Henry at 2024-02-17T06:01:44-05:00 Perf: add constant folding for bitcast between float and word (#24331) - - - - - 5fd2c00f by Sylvain Henry at 2024-02-17T06:01:44-05:00 Perf: replace stack checks with assertions in casting primops There are RESERVED_STACK_WORDS free words (currently 21) on the stack, so omit the checks. Suggested by Cheng Shao. - - - - - 401dfe7b by Sylvain Henry at 2024-02-17T06:01:44-05:00 Reexport primops from GHC.Float + add deprecation - - - - - 4ab48edb by Ben Gamari at 2024-02-17T06:02:21-05:00 rts/Hash: Don't iterate over chunks if we don't need to free data When freeing a `HashTable` there is no reason to walk over the hash list before freeing it if the user has not given us a `dataFreeFun`. Noticed while looking at #24410. - - - - - bd5a1f91 by Cheng Shao at 2024-02-17T06:03:00-05:00 compiler: add SEQ_CST fence support In addition to existing Acquire/Release fences, this commit adds SEQ_CST fence support to GHC, allowing Cmm code to explicitly emit a fence that enforces total memory ordering. The following logic is added: - The MO_SeqCstFence callish MachOp - The %prim fence_seq_cst() Cmm syntax and the SEQ_CST_FENCE macro in Cmm.h - MO_SeqCstFence lowering logic in every single GHC codegen backend - - - - - 2ce2a493 by Cheng Shao at 2024-02-17T06:03:38-05:00 testsuite: fix hs_try_putmvar002 for targets without pthread.h hs_try_putmvar002 includes pthread.h and doesn't work on targets without this header (e.g. wasm32). It doesn't need to include this header at all. This was previously unnoticed by wasm CI, though recent toolchain upgrade brought in upstream changes that completely removes pthread.h in the single-threaded wasm32-wasi sysroot, therefore we need to handle that change. - - - - - 1fb3974e by Cheng Shao at 2024-02-17T06:03:38-05:00 ci: bump ci-images to use updated wasm image This commit bumps our ci-images revision to use updated wasm image. - - - - - 56e3f097 by Andrew Lelechenko at 2024-02-17T06:04:13-05:00 Bump submodule text to 2.1.1 T17123 allocates less because of improvements to Data.Text.concat in 1a6a06a. Metric Decrease: T17123 - - - - - a7569495 by Cheng Shao at 2024-02-17T06:04:51-05:00 rts: remove redundant rCCCS initialization This commit removes the redundant logic of initializing each Capability's rCCCS to CCS_SYSTEM in initProfiling(). Before initProfiling() is called during RTS startup, each Capability's rCCCS has already been assigned CCS_SYSTEM when they're first initialized. - - - - - 7a0293cc by Ben Gamari at 2024-02-19T07:11:00-05:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 0dbd729e by Andrei Borzenkov at 2024-02-19T07:11:37-05:00 Parser, renamer, type checker for @a-binders (#17594) GHC Proposal 448 introduces binders for invisible type arguments (@a-binders) in various contexts. This patch implements @-binders in lambda patterns and function equations: {-# LANGUAGE TypeAbstractions #-} id1 :: a -> a id1 @t x = x :: t -- @t-binder on the LHS of a function equation higherRank :: (forall a. (Num a, Bounded a) => a -> a) -> (Int8, Int16) higherRank f = (f 42, f 42) ex :: (Int8, Int16) ex = higherRank (\ @a x -> maxBound @a - x ) -- @a-binder in a lambda pattern in an argument -- to a higher-order function Syntax ------ To represent those @-binders in the AST, the list of patterns in Match now uses ArgPat instead of Pat: data Match p body = Match { ... - m_pats :: [LPat p], + m_pats :: [LArgPat p], ... } + data ArgPat pass + = VisPat (XVisPat pass) (LPat pass) + | InvisPat (XInvisPat pass) (HsTyPat (NoGhcTc pass)) + | XArgPat !(XXArgPat pass) The VisPat constructor represents patterns for visible arguments, which include ordinary value-level arguments and required type arguments (neither is prefixed with a @), while InvisPat represents invisible type arguments (prefixed with a @). Parser ------ In the grammar (Parser.y), the lambda and lambda-cases productions of aexp non-terminal were updated to accept argpats instead of apats: aexp : ... - | '\\' apats '->' exp + | '\\' argpats '->' exp ... - | '\\' 'lcases' altslist(apats) + | '\\' 'lcases' altslist(argpats) ... + argpat : apat + | PREFIX_AT atype Function left-hand sides did not require any changes to the grammar, as they were already parsed with productions capable of parsing @-binders. Those binders were being rejected in post-processing (isFunLhs), and now we accept them. In Parser.PostProcess, patterns are constructed with the help of PatBuilder, which is used as an intermediate data structure when disambiguating between FunBind and PatBind. In this patch we define ArgPatBuilder to accompany PatBuilder. ArgPatBuilder is a short-lived data structure produced in isFunLhs and consumed in checkFunBind. Renamer ------- Renaming of @-binders builds upon prior work on type patterns, implemented in 2afbddb0f24, which guarantees proper scoping and shadowing behavior of bound type variables. This patch merely defines rnLArgPatsAndThen to process a mix of visible and invisible patterns: + rnLArgPatsAndThen :: NameMaker -> [LArgPat GhcPs] -> CpsRn [LArgPat GhcRn] + rnLArgPatsAndThen mk = mapM (wrapSrcSpanCps rnArgPatAndThen) where + rnArgPatAndThen (VisPat x p) = ... rnLPatAndThen ... + rnArgPatAndThen (InvisPat _ tp) = ... rnHsTyPat ... Common logic between rnArgPats and rnPats is factored out into the rn_pats_general helper. Type checker ------------ Type-checking of @-binders builds upon prior work on lazy skolemisation, implemented in f5d3e03c56f. This patch extends tcMatchPats to handle @-binders. Now it takes and returns a list of LArgPat rather than LPat: tcMatchPats :: ... - -> [LPat GhcRn] + -> [LArgPat GhcRn] ... - -> TcM ([LPat GhcTc], a) + -> TcM ([LArgPat GhcTc], a) Invisible binders in the Match are matched up with invisible (Specified) foralls in the type. This is done with a new clause in the `loop` worker of tcMatchPats: loop :: [LArgPat GhcRn] -> [ExpPatType] -> TcM ([LArgPat GhcTc], a) loop (L l apat : pats) (ExpForAllPatTy (Bndr tv vis) : pat_tys) ... -- NEW CLAUSE: | InvisPat _ tp <- apat, isSpecifiedForAllTyFlag vis = ... In addition to that, tcMatchPats no longer discards type patterns. This is done by filterOutErasedPats in the desugarer instead. x86_64-linux-deb10-validate+debug_info Metric Increase: MultiLayerModulesTH_OneShot - - - - - 486979b0 by Jade at 2024-02-19T07:12:13-05:00 Add specialized sconcat implementation for Data.Monoid.First and Data.Semigroup.First Approved CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/246 Fixes: #24346 - - - - - 17e309d2 by John Ericson at 2024-02-19T07:12:49-05:00 Fix reST in users guide It appears that aef587f65de642142c1dcba0335a301711aab951 wasn't valid syntax. - - - - - 35b0ad90 by Brandon Chinn at 2024-02-19T07:13:25-05:00 Fix searching for errors in sphinx build - - - - - 4696b966 by Cheng Shao at 2024-02-19T07:14:02-05:00 hadrian: fix wasm backend post linker script permissions The post-link.mjs script was incorrectly copied and installed as a regular data file without executable permission, this commit fixes it. - - - - - a6142e0c by Cheng Shao at 2024-02-19T07:14:40-05:00 testsuite: mark T23540 as fragile on i386 See #24449 for details. - - - - - 249caf0d by Matthew Craven at 2024-02-19T20:36:09-05:00 Add @since annotation to Data.Data.mkConstrTag - - - - - cdd939e7 by Jade at 2024-02-19T20:36:46-05:00 Enhance documentation of Data.Complex - - - - - d04f384f by Ben Gamari at 2024-02-21T04:59:23-05:00 hadrian/bindist: Ensure that phony rules are marked as such Otherwise make may not run the rule if file with the same name as the rule happens to exist. - - - - - efcbad2d by Ben Gamari at 2024-02-21T04:59:23-05:00 hadrian: Generate HSC2HS_EXTRAS variable in bindist installation We must generate the hsc2hs wrapper at bindist installation time since it must contain `--lflag` and `--cflag` arguments which depend upon the installation path. The solution here is to substitute these variables in the configure script (see mk/hsc2hs.in). This is then copied over a dummy wrapper in the install rules. Fixes #24050. - - - - - c540559c by Matthew Pickering at 2024-02-21T04:59:23-05:00 ci: Show --info for installed compiler - - - - - ab9281a2 by Matthew Pickering at 2024-02-21T04:59:23-05:00 configure: Correctly set --target flag for linker opts Previously we were trying to use the FP_CC_SUPPORTS_TARGET with 4 arguments, when it only takes 3 arguments. Instead we need to use the `FP_PROG_CC_LINKER_TARGET` function in order to set the linker flags. Actually fixes #24414 - - - - - 9460d504 by Rodrigo Mesquita at 2024-02-21T04:59:59-05:00 configure: Do not override existing linker flags in FP_LD_NO_FIXUP_CHAINS - - - - - 77629e76 by Andrei Borzenkov at 2024-02-21T05:00:35-05:00 Namespacing for fixity signatures (#14032) Namespace specifiers were added to syntax of fixity signatures: - sigdecl ::= infix prec ops | ... + sigdecl ::= infix prec namespace_spec ops | ... To preserve namespace during renaming MiniFixityEnv type now has separate FastStringEnv fields for names that should be on the term level and for name that should be on the type level. makeMiniFixityEnv function was changed to fill MiniFixityEnv in the right way: - signatures without namespace specifiers fill both fields - signatures with 'data' specifier fill data field only - signatures with 'type' specifier fill type field only Was added helper function lookupMiniFixityEnv that takes care about looking for a name in an appropriate namespace. Updates haddock submodule. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 84357d11 by Teo Camarasu at 2024-02-21T05:01:11-05:00 rts: only collect live words in nonmoving census when non-concurrent This avoids segfaults when the mutator modifies closures as we examine them. Resolves #24393 - - - - - 9ca56dd3 by Ian-Woo Kim at 2024-02-21T05:01:53-05:00 mutex wrap in refreshProfilingCCSs - - - - - 1387966a by Cheng Shao at 2024-02-21T05:02:32-05:00 rts: remove unused HAVE_C11_ATOMICS macro This commit removes the unused HAVE_C11_ATOMICS macro. We used to have a few places that have fallback paths when HAVE_C11_ATOMICS is not defined, but that is completely redundant, since the FP_CC_SUPPORTS__ATOMICS configure check will fail when the C compiler doesn't support C11 style atomics. There are also many places (e.g. in unreg backend, SMP.h, library cbits, etc) where we unconditionally use C11 style atomics anyway which work in even CentOS 7 (gcc 4.8), the oldest distro we test in our CI, so there's no value in keeping HAVE_C11_ATOMICS. - - - - - 0f40d68f by Andreas Klebinger at 2024-02-21T05:03:09-05:00 RTS: -Ds - make sure incall is non-zero before dereferencing it. Fixes #24445 - - - - - e5886de5 by Ben Gamari at 2024-02-21T05:03:44-05:00 rts/AdjustorPool: Use ExecPage abstraction This is just a minor cleanup I found while reviewing the implementation. - - - - - 09941666 by Adam Gundry at 2024-02-21T13:53:12+00:00 Define GHC2024 language edition (#24320) See https://github.com/ghc-proposals/ghc-proposals/pull/613. Also fixes #24343 and improves the documentation of language editions. Co-authored-by: Joachim Breitner <mail at joachim-breitner.de> - - - - - 5121a4ed by Ben Gamari at 2024-02-23T06:40:55-05:00 Allow docstrings after exports Here we extend the parser and AST to preserve docstrings following export items. We then extend Haddock to parse `@since` annotations in such docstrings, allowing changes in export structure to be properly documented. Bumps haddock submodule. - - - - - 0eb2265d by Hécate Moonlight at 2024-02-24T16:02:16-05:00 Improve the synopsis and description of base - - - - - 2e36f5d2 by Jade at 2024-02-24T16:02:51-05:00 Error Messages: Properly align cyclic module error Fixes: #24476 - - - - - bbfb051c by Ben Gamari at 2024-02-24T19:10:23-05:00 Allow docstrings after exports Here we extend the parser and AST to preserve docstrings following export items. We then extend Haddock to parse `@since` annotations in such docstrings, allowing changes in export structure to be properly documented. - - - - - d8d6ad8c by Ben Gamari at 2024-02-24T19:10:23-05:00 ghc-internal: Move modules into GHC.Internal.* namespace Bumps haddock submodule due to testsuite output changes. - - - - - a82af7cd by Ben Gamari at 2024-02-24T19:10:23-05:00 ghc-internal: Rewrite `@since ` to `@since base-` These will be incrementally moved to the export sites in `base` where possible. - - - - - ca3836e1 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Migrate Haddock `not-home` pragmas from `ghc-internal` This ensures that we do not use `base` stub modules as declarations' homes when not appropriate. - - - - - c8cf3e26 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Partially freeze exports of GHC.Base Sadly there are still a few module reexports. However, at least we have decoupled from the exports of `GHC.Internal.Base`. - - - - - 272573c6 by Ben Gamari at 2024-02-24T19:10:23-05:00 Move Haddock named chunks - - - - - 2d8a881d by Ben Gamari at 2024-02-24T19:10:23-05:00 Drop GHC.Internal.Data.Int - - - - - 55c4c385 by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler: Fix mention to `GHC....` modules in wasm desugaring Really, these references should be via known-key names anyways. I have fixed the proximate issue here but have opened #24472 to track the additional needed refactoring. - - - - - 64150911 by Ben Gamari at 2024-02-24T19:10:23-05:00 Accept performance shifts from ghc-internal restructure As expected, Haddock now does more work. Less expected is that some other testcases actually get faster, presumably due to less interface file loading. As well, the size_hello_artifact test regressed a bit when debug information is enabled due to debug information for the new stub symbols. Metric Decrease: T12227 T13056 Metric Increase: haddock.Cabal haddock.base MultiLayerModulesTH_OneShot size_hello_artifact - - - - - 317a915b by Ben Gamari at 2024-02-24T19:10:23-05:00 Expose GHC.Wasm.Prim from ghc-experimental Previously this was only exposed from `ghc-internal` which violates our agreement that users shall not rely on things exposed from that package. Fixes #24479. - - - - - 3bbd2bf2 by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler/tc: Small optimisation of evCallStack Don't lookupIds unless we actually need them. - - - - - 3e5c9e3c by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler/tc: Use toException instead of SomeException - - - - - 125714a6 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Factor out errorBelch This was useful when debugging - - - - - 3d6aae7c by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - 6900306e by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Move PrimMVar to GHC.Internal.MVar - - - - - 28f8a148 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Move prettyCallStack to GHC.Internal.Stack - - - - - 4892de47 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Explicit dependency to workaround #24436 Currently `ghc -M` fails to account for `.hs-boot` files correctly, leading to issues with cross-package one-shot builds failing. This currently manifests in `GHC.Exception` due to the boot file for `GHC.Internal.Stack`. Work around this by adding an explicit `import`, ensuring that `GHC.Internal.Stack` is built before `GHC.Exception`. See #24436. - - - - - 294c93a5 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Use displayException in top-level exception handler Happily this also allows us to eliminate a special case for Deadlock exceptions. Implements [CLC #198](https://github.com/haskell/core-libraries-committee/issues/198). - - - - - cf756a25 by Ben Gamari at 2024-02-24T22:11:53-05:00 rts: Fix symbol references in Wasm RTS - - - - - 4e4d47a0 by Jade at 2024-02-26T15:17:20-05:00 GHCi: Improve response to unloading, loading and reloading modules Fixes #13869 - - - - - f3de8a3c by Zubin Duggal at 2024-02-26T15:17:57-05:00 rel-eng/fetch-gitlab.py: Fix name of aarch64 alpine 3_18 release job - - - - - c71bfdff by Cheng Shao at 2024-02-26T15:18:35-05:00 hadrian/hie-bios: pass -j to hadrian This commit passes -j to hadrian in the hadrian/hie-bios scripts. When the user starts HLS in a fresh clone that has just been configured, it takes quite a while for hie-bios to pick up the ghc flags and start actual indexing, due to the fact that the hadrian build step defaulted to -j1, so -j speeds things up and improve HLS user experience in GHC. Also add -j flag to .ghcid to speed up ghcid, and sets the Windows build root to .hie-bios which also works and unifies with other platforms, the previous build root _hie-bios was missing from .gitignore anyway. - - - - - 50bfdb46 by Cheng Shao at 2024-02-26T15:18:35-05:00 ci: enable parallelism in hadrian/ghci scripts This commit enables parallelism when the hadrian/ghci scripts are called in CI. The time bottleneck is in the hadrian build step, but previously the build step wasn't parallelized. - - - - - 61a78231 by Felix Yan at 2024-02-26T15:19:14-05:00 m4: Correctly detect GCC version When calling as `cc`, GCC does not outputs lowercased "gcc" at least in 13.2.1 version here. ``` $ cc --version cc (GCC) 13.2.1 20230801 ... ``` This fails the check and outputs the confusing message: `configure: $CC is not gcc; assuming it's a reasonably new C compiler` This patch makes it check for upper-cased "GCC" too so that it works correctly: ``` checking version of gcc... 13.2.1 ``` - - - - - 001aa539 by Teo Camarasu at 2024-02-27T13:26:46-05:00 Fix formatting in whereFrom docstring Previously it used markdown syntax rather than Haddock syntax for code quotes - - - - - e8034d15 by Teo Camarasu at 2024-02-27T13:26:46-05:00 Move ClosureType type to ghc-internal - Use ClosureType for InfoProv.ipDesc. - Use ClosureType for CloneStack.closureType. - Now ghc-heap re-exports this type from ghc-internal. See the accompanying CLC proposal: https://github.com/haskell/core-libraries-committee/issues/210 Resolves #22600 - - - - - 3da0a551 by Matthew Craven at 2024-02-27T13:27:22-05:00 StgToJS: Simplify ExprInline constructor of ExprResult Its payload was used only for a small optimization in genAlts, avoiding a few assignments for programs of this form: case NormalDataCon arg1 arg2 of x { NormalDataCon x1 x2 -> ... ; } But when compiling with optimizations, this sort of code is generally eliminated by case-of-known-constructor in Core-to-Core. So it doesn't seem worth tracking and cleaning up again in StgToJS. - - - - - 61bc92cc by Cheng Shao at 2024-02-27T16:58:42-05:00 rts: add missing ccs_mutex guard to internal_dlopen See added comment for details. Closes #24423. - - - - - dd29d3b2 by doyougnu at 2024-02-27T16:59:23-05:00 cg: Remove GHC.Cmm.DataFlow.Collections In pursuit of #15560 and #17957 and generally removing redundancy. - - - - - d3a050d2 by Cheng Shao at 2024-02-27T17:00:00-05:00 utils: remove unused lndir from tree Ever since the removal of the make build system, the in tree lndir hasn't been actually built, so this patch removes it. - - - - - 74b24a9b by Teo Camarasu at 2024-02-28T16:32:58+00:00 rts: avoid checking bdescr of value outside of Haskell heap In nonmovingTidyWeaks we want to check if the key of a weak pointer lives in the non-moving heap. We do this by checking the flags of the block the key lives in. But we need to be careful with values that live outside the Haskell heap, since they will lack a block descriptor and looking for one may lead to a segfault. In this case we should just accept that it isn't on the non-moving heap. Resolves #24492 - - - - - b4cae4ec by Simon Peyton Jones at 2024-02-29T02:10:08-05:00 In mkDataConRep, ensure the in-scope set is right A small change that fixes #24489 - - - - - 3836a110 by Cheng Shao at 2024-02-29T21:25:45-05:00 testsuite: fix T23540 fragility on 32-bit platforms T23540 is fragile on 32-bit platforms. The root cause is usage of `getEvidenceTreesAtPoint`, which internally relies on `Name`'s `Ord` instance, which is indeterministic. The solution is adding a deterministic `Ord` instance for `EvidenceInfo` and sorting the evidence trees before pretty printing. Fixes #24449. - - - - - 960c8d47 by Teo Camarasu at 2024-02-29T21:26:20-05:00 Reduce AtomicModifyIORef increment count This test leads to a lot of contention when N>2 and becomes very slow. Let's reduce the amount of work we do to compensate. Resolves #24490 - - - - - 2e46c8ad by Matthew Pickering at 2024-03-01T05:48:06-05:00 hadrian: Improve parallelism in binary-dist-dir rule I noticed that the "docs" target was needed after the libraries and executables were built. We can improve the parallelism by needing everything at once so that documentation can be built immediately after a library is built for example. - - - - - cb6c11fe by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: Bump windows and freebsd boot compilers to 9.6.4 We have previously bumped the docker images to use 9.6.4, but neglected to bump the windows images until now. - - - - - 30f06996 by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: darwin: Update to 9.6.2 for boot compiler 9.6.4 is currently broken due to #24050 Also update to use LLVM-15 rather than LLVM-11, which is out of date. - - - - - d9d69e12 by Matthew Pickering at 2024-03-01T05:48:07-05:00 Bump minimum bootstrap version to 9.6 - - - - - 67ace1c5 by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: Enable more documentation building Here we enable documentation building on 1. Darwin: The sphinx toolchain was already installed so we enable html and manpages. 2. Rocky8: Full documentation (toolchain already installed) 3. Alpine: Full documetnation (toolchain already installed) 4. Windows: HTML and manpages (toolchain already installed) Fixes #24465 - - - - - 39583c39 by Matthew Pickering at 2024-03-01T05:48:42-05:00 ci: Bump ci-images to allow updated aarch64-alpine image with llvm15 and clang15 - - - - - d91d00fc by Torsten Schmits at 2024-03-01T15:01:50-05:00 Introduce ListTuplePuns extension This implements Proposal 0475, introducing the `ListTuplePuns` extension which is enabled by default. Disabling this extension makes it invalid to refer to list, tuple and sum type constructors by using built-in syntax like `[Int]`, `(Int, Int)`, `(# Int#, Int# #)` or `(# Int | Int #)`. Instead, this syntax exclusively denotes data constructors for use with `DataKinds`. The conventional way of referring to these data constructors by prefixing them with a single quote (`'(Int, Int)`) is now a parser error. Tuple declarations have been moved to `GHC.Tuple.Prim` and the `Solo` data constructor has been renamed to `MkSolo` (in a previous commit). Unboxed tuples and sums now have real source declarations in `GHC.Types`. Unit and solo types for tuples are now called `Unit`, `Unit#`, `Solo` and `Solo#`. Constraint tuples now have the unambiguous type constructors `CTuple<n>` as well as `CUnit` and `CSolo`, defined in `GHC.Classes` like before. A new parser construct has been added for the unboxed sum data constructor declarations. The type families `Tuple`, `Sum#` etc. that were intended to provide nicer syntax have been omitted from this change set due to inference problems, to be implemented at a later time. See the MR discussion for more info. Updates the submodule utils/haddock. Updates the cabal submodule due to new language extension. Metric Increase: haddock.base Metric Decrease: MultiLayerModulesTH_OneShot size_hello_artifact Proposal document: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst Merge request: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8820 Tracking ticket: https://gitlab.haskell.org/ghc/ghc/-/issues/21294 - - - - - bbdb6286 by Sylvain Henry at 2024-03-01T15:01:50-05:00 JS linker: filter unboxed tuples - - - - - dec6d8d3 by Arnaud Spiwack at 2024-03-01T15:02:30-05:00 Improve error messages coming from non-linear patterns This enriched the `CtOrigin` for non-linear patterns to include data of the pattern that created the constraint (which can be quite useful if it occurs nested in a pattern) as well as an explanation why the pattern is non-restricted in (at least in some cases). - - - - - 6612388e by Arnaud Spiwack at 2024-03-01T15:02:30-05:00 Adjust documentation of linear lets according to committee decision - - - - - 1c064ef1 by Cheng Shao at 2024-03-02T17:11:19-05:00 compiler: start deprecating cmmToRawCmmHook cmmToRawCmmHook was added 4 years ago in d561c8f6244f8280a2483e8753c38e39d34c1f01. Its only user is the Asterius project, which has been archived and deprecated in favor of the ghc wasm backend. This patch starts deprecating cmmToRawCmmHook by placing a DEPRECATED pragma, and actual removal shall happen in a future GHC major release if no issue to oppose the deprecation has been raised in the meantime. - - - - - 9b74845f by Andrew Lelechenko at 2024-03-02T17:11:55-05:00 Data.List.NonEmpty.unzip: use WARNING with category instead of DEPRECATED CLC proposal: https://github.com/haskell/core-libraries-committee/issues/258 - - - - - 61bb5ff6 by Finley McIlwaine at 2024-03-04T09:01:40-08:00 add -fprof-late-overloaded and -fprof-late-overloaded-calls * Refactor late cost centre insertion for extensibility * Add two more late cost centre insertion methods that add SCCs to overloaded top level bindings and call sites with dictionary arguments. * Some tests for the basic functionality of the new insertion methods Resolves: #24500 - - - - - 82ccb801 by Andreas Klebinger at 2024-03-04T19:59:14-05:00 x86-ncg: Fix fma codegen when arguments are globals Fix a bug in the x86 ncg where results would be wrong when the desired output register and one of the input registers were the same global. Also adds a tiny optimization to make use of the memory addressing support when convenient. Fixes #24496 - - - - - 18ad1077 by Matthew Pickering at 2024-03-05T14:22:31-05:00 rel_eng: Update hackage docs upload scripts This adds the upload of ghc-internal and ghc-experimental to our scripts which upload packages to hackage. - - - - - bf47c9ba by Matthew Pickering at 2024-03-05T14:22:31-05:00 docs: Remove stray module comment from GHC.Profiling.Eras - - - - - 37d9b340 by Matthew Pickering at 2024-03-05T14:22:31-05:00 Fix ghc-internal cabal file The file mentioned some artifacts relating to the base library. I have renamed these to the new ghc-internal variants. - - - - - 23f2a478 by Matthew Pickering at 2024-03-05T14:22:31-05:00 Fix haddock source links and hyperlinked source There were a few issues with the hackage links: 1. We were using the package id rather than the package name for the package links. This is fixed by now allowing the template to mention %pkg% or %pkgid% and substituing both appropiatly. 2. The `--haddock-base-url` flag is renamed to `--haddock-for-hackage` as the new base link works on a local or remote hackage server. 3. The "src" path including too much stuff, so cross-package source links were broken as the template was getting double expanded. Fixes #24086 - - - - - 2fa336a9 by Ben Gamari at 2024-03-05T14:23:07-05:00 filepath: Bump submodule to 1.5.2.0 - - - - - 31217944 by Ben Gamari at 2024-03-05T14:23:07-05:00 os-string: Bump submodule to 2.0.2 - - - - - 4074a3f2 by Matthew Pickering at 2024-03-05T21:44:35-05:00 base: Reflect new era profiling RTS flags in GHC.RTS.Flags * -he profiling mode * -he profiling selector * --automatic-era-increment CLC proposal #254 - https://github.com/haskell/core-libraries-committee/issues/254 - - - - - a8c0e31b by Sylvain Henry at 2024-03-05T21:45:14-05:00 JS: faster implementation for some numeric primitives (#23597) Use faster implementations for the following primitives in the JS backend by not using JavaScript's BigInt: - plusInt64 - minusInt64 - minusWord64 - timesWord64 - timesInt64 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 21e3f325 by Cheng Shao at 2024-03-05T21:45:52-05:00 rts: add -xr option to control two step allocator reserved space size This patch adds a -xr RTS option to control the size of virtual memory address space reserved by the two step allocator on a 64-bit platform, see added documentation for explanation. Closes #24498. - - - - - dedcf102 by Cheng Shao at 2024-03-06T13:39:04-05:00 rts: expose HeapAlloc.h as public header This commit exposes HeapAlloc.h as a public header. The intention is to expose HEAP_ALLOCED/HEAP_ALLOCED_GC, so they can be used in assertions in other public headers, and they may also be useful for user code. - - - - - d19441d7 by Cheng Shao at 2024-03-06T13:39:04-05:00 rts: assert pointer is indeed heap allocated in Bdescr() This commit adds an assertion to Bdescr() to assert the pointer is indeed heap allocated. This is useful to rule out RTS bugs that attempt to access non-existent block descriptor of a static closure, #24492 being one such example. - - - - - 9a656a04 by Ben Gamari at 2024-03-06T13:39:39-05:00 ghc-experimental: Add dummy dependencies to work around #23942 This is a temporary measure to improve CI reliability until a proper solution is developed. Works around #23942. - - - - - 1e84b924 by Simon Peyton Jones at 2024-03-06T13:39:39-05:00 Three compile perf improvements with deep nesting These were changes are all triggered by #24471. 1. Make GHC.Core.Opt.SetLevels.lvlMFE behave better when there are many free variables. See Note [Large free-variable sets]. 2. Make GHC.Core.Opt.Arity.floatIn a bit lazier in its Cost argument. This benefits the common case where the ArityType turns out to be nullary. See Note [Care with nested expressions] 3. Make GHC.CoreToStg.Prep.cpeArg behave for deeply-nested expressions. See Note [Eta expansion of arguments in CorePrep] wrinkle (EA2). Compile times go down by up to 4.5%, and much more in artificial cases. (Geo mean of compiler/perf changes is -0.4%.) Metric Decrease: CoOpt_Read T10421 T12425 - - - - - c4b13113 by Hécate Moonlight at 2024-03-06T13:40:17-05:00 Use "module" instead of "library" when applicable in base haddocks - - - - - 9cd9efb4 by Vladislav Zavialov at 2024-03-07T13:01:54+03:00 Rephrase error message to say "visible arguments" (#24318) * Main change: make the error message generated by mkFunTysMsg more accurate by changing "value arguments" to "visible arguments". * Refactor: define a new type synonym VisArity and use it instead of Arity in a few places. It might be the case that there other places in the compiler that should talk about visible arguments rather than value arguments, but I haven't tried to find them all, focusing only on the error message reported in the ticket. - - - - - d523a6a7 by Ben Gamari at 2024-03-07T19:40:45-05:00 Bump array submodule - - - - - 7e55003c by Ben Gamari at 2024-03-07T19:40:45-05:00 Bump stm submodule - - - - - 32d337ef by Ben Gamari at 2024-03-07T19:40:45-05:00 Introduce exception context Here we introduce the `ExceptionContext` type and `ExceptionAnnotation` class, allowing dynamically-typed user-defined annotations to be attached to exceptions. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/199 GHC Proposal: https://github.com/ghc-proposals/ghc-proposals/pull/330 - - - - - 39f3d922 by Ben Gamari at 2024-03-07T19:40:46-05:00 testsuite/interface-stability: Update documentation - - - - - fdea7ada by Ben Gamari at 2024-03-07T19:40:46-05:00 ghc-internal: comment formatting - - - - - 4fba42ef by Ben Gamari at 2024-03-07T19:40:46-05:00 compiler: Default and warn ExceptionContext constraints - - - - - 3886a205 by Ben Gamari at 2024-03-07T19:40:46-05:00 base: Introduce exception backtraces Here we introduce the `Backtraces` type and associated machinery for attaching these via `ExceptionContext`. These has a few compile-time regressions (`T15703` and `T9872d`) due to the additional dependencies in the exception machinery. As well, there is a surprisingly large regression in the `size_hello_artifact` test. This appears to be due to various `Integer` and `Read` bits now being reachable at link-time. I believe it should be possible to avoid this but I have accepted the change for now to get the feature merged. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/199 GHC Proposal: https://github.com/ghc-proposals/ghc-proposals/pull/330 Metric Increase: T15703 T9872d size_hello_artifact - - - - - 18c5409f by Ben Gamari at 2024-03-07T19:40:46-05:00 users guide: Release notes for exception backtrace work - - - - - f849c5fc by Ben Gamari at 2024-03-07T19:40:46-05:00 compiler: Don't show ExceptionContext of GhcExceptions Most GhcExceptions are user-facing errors and therefore the ExceptionContext has little value. Ideally we would enable it in the DEBUG compiler but I am leaving this for future work. - - - - - dc646e6f by Sylvain Henry at 2024-03-07T19:40:46-05:00 Disable T9930fail for the JS target (cf #19174) - - - - - bfc09760 by Alan Zimmerman at 2024-03-07T19:41:22-05:00 Update showAstData to honour blanking of AnnParen Also tweak rendering of SrcSpan to remove extra blank line. - - - - - 50454a29 by Ben Gamari at 2024-03-08T03:32:42-05:00 ghc-internal: Eliminate GHC.Internal.Data.Kind This was simply reexporting things from `ghc-prim`. Instead reexport these directly from `Data.Kind`. Also add build ordering dependency to work around #23942. - - - - - 38a4b6ab by Ben Gamari at 2024-03-08T03:33:18-05:00 rts: Fix SET_HDR initialization of retainer set This fixes a regression in retainer set profiling introduced by b0293f78cb6acf2540389e22bdda420d0ab874da. Prior to that commit the heap traversal word would be initialized by `SET_HDR` using `LDV_RECORD_CREATE`. However, the commit added a `doingLDVProfiling` check in `LDV_RECORD_CREATE`, meaning that this initialization no longer happened. Given that this initialization was awkwardly indirectly anyways, I have fixed this by explicitly initializating the heap traversal word to `NULL` in `SET_PROF_HDR`. This is equivalent to the previous behavior, but much more direct. Fixes #24513. - - - - - 2859a637 by Ben Gamari at 2024-03-08T18:26:47-05:00 base: Use strerror_r instead of strerror As noted by #24344, `strerror` is not necessarily thread-safe. Thankfully, POSIX.1-2001 has long offered `strerror_r`, which is safe to use. Fixes #24344. CLC discussion: https://github.com/haskell/core-libraries-committee/issues/249 - - - - - edb9bf77 by Jade at 2024-03-09T03:39:38-05:00 Error messages: Improve Error messages for Data constructors in type signatures. This patch improves the error messages from invalid type signatures by trying to guess what the user did and suggesting an appropriate fix. Partially fixes: #17879 - - - - - cfb197e3 by Patrick at 2024-03-09T03:40:15-05:00 HieAst: add module name #24493 The main purpose of this is to tuck the module name `xxx` in `module xxx where` into the hieAst. It should fix #24493. The following have been done: 1. Renamed and update the `tcg_doc_hdr :: Maybe (LHsDoc GhcRn)` to `tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName))` To store the located module name information. 2. update the `RenamedSource` and `RenamedStuff` with extra `Maybe (XRec GhcRn ModuleName)` located module name information. 3. add test `testsuite/tests/hiefile/should_compile/T24493.hs` to ensure the module name is added and update several relevent tests. 4. accompanied submodule haddoc test update MR in https://gitlab.haskell.org/ghc/haddock/-/merge_requests/53 - - - - - 2341d81e by Vaibhav Sagar at 2024-03-09T03:40:54-05:00 GHC.Utils.Binary: fix a couple of typos - - - - - 5580e1bd by Ben Gamari at 2024-03-09T03:41:30-05:00 rts: Drop .wasm suffix from .prof file names This replicates the behavior on Windows, where `Hi.exe` will produce profiling output named `Hi.prof` instead of `Hi.exe.prof`. While in the area I also fixed the extension-stripping logic, which incorrectly rewrote `Hi.exefoo` to `Hi.foo`. Closes #24515. - - - - - 259495ee by Cheng Shao at 2024-03-09T03:41:30-05:00 testsuite: drop exe extension from .hp & .prof filenames See #24515 for details. - - - - - c477a8d2 by Ben Gamari at 2024-03-09T03:42:05-05:00 rts/linker: Enable GOT support on all platforms There is nothing platform-dependent about our GOT implementation and GOT support is needed by `T24171` on i386. - - - - - 2e592857 by Vladislav Zavialov at 2024-03-09T03:42:41-05:00 Drop outdated comment on TcRnIllformedTypePattern This should have been done in 0f0c53a501b but I missed it. - - - - - c554b4da by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/CloneStack: Bounds check array write - - - - - 15c590a5 by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/CloneStack: Don't expose helper functions in header - - - - - e831ce31 by Ben Gamari at 2024-03-09T09:39:20-05:00 base: Move internals of GHC.InfoProv into GHC.InfoProv.Types Such that we can add new helpers into GHC.InfoProv.Types without breakage. - - - - - 6948e24d by Ben Gamari at 2024-03-09T09:39:20-05:00 rts: Lazily decode IPE tables Previously we would eagerly allocate `InfoTableEnt`s for each info table registered in the info table provenance map. However, this costs considerable memory and initialization time. Instead we now lazily decode these tables. This allows us to use one-third the memory *and* opens the door to taking advantage of sharing opportunities within a module. This required considerable reworking since lookupIPE now must be passed its result buffer. - - - - - 9204a04e by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/IPE: Don't expose helper in header - - - - - 308926ff by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/IPE: Share module_name within a Node This allows us to shave a 64-bit word off of the packed IPE entry size. - - - - - bebdea05 by Ben Gamari at 2024-03-09T09:39:20-05:00 IPE: Expose unit ID in InfoTableProv Here we add the unit ID to the info table provenance structure. - - - - - 6519c9ad by Ben Gamari at 2024-03-09T09:39:35-05:00 rts: Refactor GHC.Stack.CloneStack.decode Don't allocate a Ptr constructor per frame. - - - - - ed0b69dc by Ben Gamari at 2024-03-09T09:39:35-05:00 base: Do not expose whereFrom# from GHC.Exts - - - - - 2b1faea9 by Vladislav Zavialov at 2024-03-09T17:38:21-05:00 docs: Update info on TypeAbstractions * Mention TypeAbstractions in 9.10.1-notes.rst * Set the status to "Experimental". * Add a "Since: GHC 9.x" comment to each section. - - - - - f8b88918 by Ben Gamari at 2024-03-09T21:21:46-05:00 ci-images: Bump Alpine image to bootstrap with 9.8.2 - - - - - 705e6927 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Mark T24171 as fragile due to #24512 I will fix this but not in time for 9.10.1-alpha1 - - - - - c74196e1 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Mark linker_unload_native as fragile In particular this fails on platforms without `dlinfo`. I plan to address this but not before 9.10.1-alpha1. - - - - - f4d87f7a by Ben Gamari at 2024-03-09T21:21:46-05:00 configure: Bump version to 9.10 - - - - - 88df9a5f by Ben Gamari at 2024-03-09T21:21:46-05:00 Bump transformers submodule to 0.6.1.1 - - - - - 8176d5e8 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Increase ulimit for T18623 1 MByte was just too tight and failed intermittently on some platforms (e.g. CentOS 7). Bumping the limit to 8 MByte should provide sufficient headroom. Fixes #23139. - - - - - c74b38a3 by Ben Gamari at 2024-03-09T21:21:46-05:00 base: Bump version to 4.20.0.0 - - - - - b2937fc3 by Ben Gamari at 2024-03-09T21:21:46-05:00 ghc-internal: Set initial version at 9.1001.0 This provides PVP compliance while maintaining a clear correspondence between GHC releases and `ghc-internal` versions. - - - - - 4ae7d868 by Ben Gamari at 2024-03-09T21:21:46-05:00 ghc-prim: Bump version to 0.11.0 - - - - - 50798dc6 by Ben Gamari at 2024-03-09T21:21:46-05:00 template-haskell: Bump version to 2.22.0.0 - - - - - 8564f976 by Ben Gamari at 2024-03-09T21:21:46-05:00 base-exports: Accommodate spurious whitespace changes in 32-bit output It appears that this was - - - - - 9d4f0e98 by Ben Gamari at 2024-03-09T21:21:46-05:00 users-guide: Move exception backtrace relnotes to 9.10 This was previously mistakenly added to the GHC 9.8 release notes. - - - - - 145eae60 by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/rel_eng: Fix name of Rocky8 artifact - - - - - 39c2a630 by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/rel_eng: Fix path of generate_jobs_metadata - - - - - aed034de by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/upload: Rework recompression The old `combine` approach was quite fragile due to use of filename globbing. Moreover, it didn't parallelize well. This refactoring makes the goal more obvious, parallelizes better, and is more robust. - - - - - dc207d06 by Ben Gamari at 2024-03-10T08:56:08-04:00 configure: Bump GHC version to 9.11 Bumps haddock submodule. - - - - - 8b2513e8 by Ben Gamari at 2024-03-11T01:20:03-04:00 rts/linker: Don't unload code when profiling is enabled The heap census may contain references (e.g. `Counter.identity`) to static data which must be available when the census is reported at the end of execution. Fixes #24512. - - - - - 7810b4c3 by Ben Gamari at 2024-03-11T01:20:03-04:00 rts/linker: Don't unload native objects when dlinfo isn't available To do so is unsafe as we have no way of identifying references to symbols provided by the object. Fixes #24513. Fixes #23993. - - - - - 0590764c by Ben Gamari at 2024-03-11T01:20:39-04:00 rel_eng/upload: Purge both $rel_name/ and $ver/ This is necessary for prereleases, where GHCup accesses the release via `$ver/` - - - - - b85a4631 by Brandon Chinn at 2024-03-12T19:25:56-04:00 Remove duplicate code normalising slashes - - - - - c91946f9 by Brandon Chinn at 2024-03-12T19:25:56-04:00 Simplify regexes with raw strings - - - - - 1a5f53c6 by Brandon Chinn at 2024-03-12T19:25:57-04:00 Don't normalize backslashes in characters - - - - - 7ea971d3 by Andrei Borzenkov at 2024-03-12T19:26:32-04:00 Fix compiler crash caused by implicit RHS quantification in type synonyms (#24470) - - - - - 39f3ac3e by Cheng Shao at 2024-03-12T19:27:11-04:00 Revert "compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms" This reverts commit 615eb855416ce536e02ed935ecc5a6f25519ae16. It was originally intended to fix #24449, but it was merely sweeping the bug under the rug. 3836a110577b5c9343915fd96c1b2c64217e0082 has properly fixed the fragile test, and we no longer need the C version of genSym. Furthermore, the C implementation causes trouble when compiling with clang that targets i386 due to alignment warning and libatomic linking issue, so it makes sense to revert it. - - - - - e6bfb85c by Cheng Shao at 2024-03-12T19:27:11-04:00 compiler: fix out-of-bound memory access of genSym on 32-bit This commit fixes an unnoticed out-of-bound memory access of genSym on 32-bit. ghc_unique_inc is 32-bit sized/aligned on 32-bit platforms, but we mistakenly treat it as a Word64 pointer in genSym, and therefore will accidentally load 2 garbage higher bytes, or with a small but non-zero chance, overwrite something else in the data section depends on how the linker places the data segments. This regression was introduced in !11802 and fixed here. - - - - - 77171cd1 by Ben Orchard at 2024-03-14T09:00:40-04:00 Note mutability of array and address access primops Without an understanding of immutable vs. mutable memory, the index primop family have a potentially non-intuitive type signature: indexOffAddr :: Addr# -> Int# -> a readOffAddr :: Addr# -> Int# -> State# d -> (# State# d, a #) indexOffAddr# might seem like a free generality improvement, which it certainly is not! This change adds a brief note on mutability expectations for most index/read/write access primops. - - - - - 7da7f8f6 by Alan Zimmerman at 2024-03-14T09:01:15-04:00 EPA: Fix regression discarding comments in contexts Closes #24533 - - - - - 73be65ab by Fendor at 2024-03-19T01:42:53-04:00 Fix sharing of 'IfaceTyConInfo' during core to iface type translation During heap analysis, we noticed that during generation of 'mi_extra_decls' we have lots of duplicates for the instances: * `IfaceTyConInfo NotPromoted IfaceNormalTyCon` * `IfaceTyConInfo IsPromoted IfaceNormalTyCon` which should be shared instead of duplicated. This duplication increased the number of live bytes by around 200MB while loading the agda codebase into GHCi. These instances are created during `CoreToIface` translation, in particular `toIfaceTyCon`. The generated core looks like: toIfaceTyCon = \ tc_sjJw -> case $wtoIfaceTyCon tc_sjJw of { (# ww_sjJz, ww1_sjNL, ww2_sjNM #) -> IfaceTyCon ww_sjJz (IfaceTyConInfo ww1_sjNL ww2_sjNM) } whichs removes causes the sharing to work propery. Adding explicit sharing, with NOINLINE annotations, changes the core to: toIfaceTyCon = \ tc_sjJq -> case $wtoIfaceTyCon tc_sjJq of { (# ww_sjNB, ww1_sjNC #) -> IfaceTyCon ww_sjNB ww1_sjNC } which looks much more like sharing is happening. We confirmed via ghc-debug that all duplications were eliminated and the number of live bytes are noticeably reduced. - - - - - bd8209eb by Alan Zimmerman at 2024-03-19T01:43:28-04:00 EPA: Address more 9.10.1-alpha1 regressions from recent changes Closes #24533 Hopefully for good this time - - - - - 31bf85ee by Fendor at 2024-03-19T14:48:08-04:00 Escape multiple arguments in the settings file Uses responseFile syntax. The issue arises when GHC is installed on windows into a location that has a space, for example the user name is 'Fake User'. The $topdir will also contain a space, consequentially. When we resolve the top dir in the string `-I$topdir/mingw/include`, then `words` will turn this single argument into `-I/C/Users/Fake` and `User/.../mingw/include` which trips up the flag argument parser of various tools such as gcc or clang. We avoid this by escaping the $topdir before replacing it in `initSettngs`. Additionally, we allow to escape spaces and quotation marks for arguments in `settings` file. Add regression test case to count the number of options after variable expansion and argument escaping took place. Additionally, we check that escaped spaces and double quotation marks are correctly parsed. - - - - - f45f700e by Matthew Pickering at 2024-03-19T14:48:44-04:00 Read global package database from settings file Before this patch, the global package database was always assumed to be in libdir </> package.conf.d. This causes issues in GHC's build system because there are sometimes situations where the package database you need to use is not located in the same place as the settings file. * The stage1 compiler needs to use stage1 libraries, so we should set "Global Package DB" for the stage1 compiler to the stage1 package database. * Stage 2 cross compilers need to use stage2 libraries, so likewise, we should set the package database path to `_build/stage2/lib/` * The normal situation is where the stage2 compiler uses stage1 libraries. Then everything lines up. * When installing we have rearranged everything so that the settings file and package database line up properly, so then everything should continue to work as before. In this case we set the relative package db path to `package.conf.d`, so it resolves the same as before. * ghc-pkg needs to be modified as well to look in the settings file fo the package database rather than assuming the global package database location relative to the lib folder. * Cabal/cabal-install will work correctly because they query the global package database using `--print-global-package-db`. A reasonable question is why not generate the "right" settings files in the right places in GHC's build system. In order to do this you would need to engineer wrappers for all executables to point to a specific libdir. There are also situations where the same package db is used by two different compilers with two different settings files (think stage2 cross compiler and stage3 compiler). In short, this 10 line patch allows for some reasonable simplifications in Hadrian at very little cost to anything else. Fixes #24502 - - - - - 4c8f1794 by Matthew Pickering at 2024-03-19T14:48:44-04:00 hadrian: Remove stage1 testsuite wrappers logic Now instead of producing wrappers which pass the global package database argument to ghc and ghc-pkg, we write the location of the correct package database into the settings file so you can just use the intree compiler directly. - - - - - da0d8ba5 by Matthew Craven at 2024-03-19T14:49:20-04:00 Remove unused ghc-internal module "GHC.Internal.Constants" - - - - - b56d2761 by Matthew Craven at 2024-03-19T14:49:20-04:00 CorePrep: Rework lowering of BigNat# literals Don't use bigNatFromWord#, because that's terrible: * We shouldn't have to traverse a linked list at run-time to build a BigNat# literal. That's just silly! * The static List object we have to create is much larger than the actual BigNat#'s contents, bloating code size. * We have to read the corresponding interface file, which causes un-tracked implicit dependencies. (#23942) Instead, encode them into the appropriate platform-dependent sequence of bytes, and generate code that copies these bytes at run-time from an Addr# literal into a new ByteArray#. A ByteArray# literal would be the correct thing to generate, but these are not yet supported; see also #17747. Somewhat surprisingly, this change results in a slight reduction in compiler allocations, averaging around 0.5% on ghc's compiler performance tests, including when compiling programs that contain no bignum literals to begin with. The specific cause of this has not been investigated. Since this lowering no longer reads the interface file for GHC.Num.BigNat, the reasoning in Note [Depend on GHC.Num.Integer] is obsoleted. But the story of un-tracked built-in dependencies remains complex, and Note [Tracking dependencies on primitives] now exists to explain this complexity. Additionally, many empty imports have been modified to refer to this new note and comply with its guidance. Several empty imports necessary for other reasons have also been given brief explanations. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 349ea330 by Fendor at 2024-03-19T14:50:00-04:00 Eliminate thunk in 'IfaceTyCon' Heap analysis showed that `IfaceTyCon` retains a thunk to `IfaceTyConInfo`, defeating the sharing of the most common instances of `IfaceTyConInfo`. We make sure the indirection is removed by adding bang patterns to `IfaceTyCon`. Experimental results on the agda code base, where the `mi_extra_decls` were read from disk: Before this change, we observe around 8654045 instances of: `IfaceTyCon[Name,THUNK_1_0]` But these thunks almost exclusively point to a shared value! Forcing the thunk a little bit more, leads to `ghc-debug` reporting: `IfaceTyCon[Name:Name,IfaceTyConInfo]` and a noticeable reduction of live bytes (on agda ~10%). - - - - - 594bee0b by Krzysztof Gogolewski at 2024-03-19T14:50:36-04:00 Minor misc cleanups - GHC.HsToCore.Foreign.JavaScript: remove dropRuntimeRepArgs; boxed tuples don't take RuntimeRep args - GHC.HsToCore.Foreign.Call: avoid partial pattern matching - GHC.Stg.Unarise: strengthen the assertion; we can assert that non-rubbish literals are unary rather than just non-void - GHC.Tc.Gen.HsType: make sure the fsLit "literal" rule fires - users_guide/using-warnings.rst: remove -Wforall-identifier, now deprecated and does nothing - users_guide/using.rst: fix formatting - andy_cherry/test.T: remove expect_broken_for(23272...), 23272 is fixed The rest are simple cleanups. - - - - - cf55a54b by Ben Gamari at 2024-03-19T14:51:12-04:00 mk/relpath: Fix quoting Previously there were two instances in this script which lacked proper quoting. This resulted in `relpath` invocations in the binary distribution Makefile producing incorrect results on Windows, leading to confusing failures from `sed` and the production of empty package registrations. Fixes #24538. - - - - - 5ff88389 by Bryan Richter at 2024-03-19T14:51:48-04:00 testsuite: Disable T21336a on wasm - - - - - 60023351 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian/bindist: Eliminate extraneous `dirname` invocation Previously we would call `dirname` twice per installed library file. We now instead reuse this result. This helps appreciably on Windows, where processes are quite expensive. - - - - - 616ac300 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian: Package mingw toolchain in expected location This fixes #24525, a regression due to 41cbaf44a6ab5eb9fa676d65d32df8377898dc89. Specifically, GHC expects to find the mingw32 toolchain in the binary distribution root. However, after this patch it was packaged in the `lib/` directory. - - - - - de9daade by Ben Gamari at 2024-03-19T22:33:11-04:00 gitlab/rel_eng: More upload.sh tweaks - - - - - 1dfe12db by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_eng: Drop dead prepare_docs codepath - - - - - dd2d748b by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_env/recompress_all: unxz before recompressing Previously we would rather compress the xz *again*, before in addition compressing it with the desired scheme. Fixes #24545. - - - - - 9d936c57 by Ben Gamari at 2024-03-19T22:33:11-04:00 mk-ghcup-metadata: Fix directory of testsuite tarball As reported in #24546, the `dlTest` artifact should be extracted into the `testsuite` directory. - - - - - 6d398066 by Ben Gamari at 2024-03-19T22:33:11-04:00 ghcup-metadata: Don't populate dlOutput unless necessary ghcup can apparently infer the output name of an artifact from its URL. Consequently, we should only include the `dlOutput` field when it would differ from the filename of `dlUri`. Fixes #24547. - - - - - 576f8b7e by Zubin Duggal at 2024-03-19T22:33:46-04:00 Revert "Apply shellcheck suggestion to SUBST_TOOLDIR" This reverts commit c82770f57977a2b5add6e1378f234f8dd6153392. The shellcheck suggestion is spurious and results in SUBST_TOOLDIR being a no-op. `set` sets positional arguments for bash, but we want to set the variable given as the first autoconf argument. Fixes #24542 Metric decreases because the paths in the settings file are now shorter, so we allocate less when we read the settings file. ------------------------- Metric Decrease: T12425 T13035 T9198 ------------------------- - - - - - cdfe6e01 by Fendor at 2024-03-19T22:34:22-04:00 Compact serialisation of IfaceAppArgs In #24563, we identified that IfaceAppArgs serialisation tags each cons cell element with a discriminator byte. These bytes add up quickly, blowing up interface files considerably when '-fwrite-if-simplified-core' is enabled. We compact the serialisation by writing out the length of 'IfaceAppArgs', followed by serialising the elements directly without any discriminator byte. This improvement can decrease the size of some interface files by up to 35%. - - - - - 97a2bb1c by Simon Peyton Jones at 2024-03-20T17:11:29+00:00 Expand untyped splices in tcPolyExprCheck Fixes #24559 - - - - - 5f275176 by Alan Zimmerman at 2024-03-20T22:44:12-04:00 EPA: Clean up Exactprint helper functions a bit - Introduce a helper lens to compose on `EpAnn a` vs `a` versions - Rename some prime versions of functions back to non-prime They were renamed during the rework - - - - - da2a10ce by Vladislav Zavialov at 2024-03-20T22:44:48-04:00 Type operators in promoteOccName (#24570) Type operators differ from term operators in that they are lexically classified as (type) constructors, not as (type) variables. Prior to this change, promoteOccName did not account for this difference, causing a scoping issue that affected RequiredTypeArguments. type (!@#) = Bool f = idee (!@#) -- Not in scope: ‘!@#’ (BUG) Now we have a special case in promoteOccName to account for this. - - - - - 247fc0fa by Preetham Gujjula at 2024-03-21T10:19:18-04:00 docs: Remove mention of non-existent Ord instance for Complex The documentation for Data.Complex says that the Ord instance for Complex Float is deficient, but there is no Ord instance for Complex a. The Eq instance for Complex Float is similarly deficient, so we use that as an example instead. - - - - - 6fafc51e by Andrei Borzenkov at 2024-03-21T10:19:54-04:00 Fix TH handling in `pat_to_type_pat` function (#24571) There was missing case for `SplicePat` in `pat_to_type_at` function, hence patterns with splicing that checked against `forall->` doesn't work properly because they fall into the "illegal pattern" case. Code example that is now accepted: g :: forall a -> () g $([p| a |]) = () - - - - - 52072f8e by Sylvain Henry at 2024-03-21T21:01:59-04:00 Type-check default declarations before deriving clauses (#24566) See added Note and #24566. Default declarations must be type-checked before deriving clauses. - - - - - 7dfdf3d9 by Sylvain Henry at 2024-03-21T21:02:40-04:00 Lexer: small perf changes - Use unsafeChr because we know our values to be valid - Remove some unnecessary use of `ord` (return Word8 values directly) - - - - - 864922ef by Sylvain Henry at 2024-03-21T21:02:40-04:00 JS: fix some comments - - - - - 3e0b2b1f by Sebastian Graf at 2024-03-21T21:03:16-04:00 Simplifier: Re-do dependency analysis in abstractFloats (#24551) In #24551, we abstracted a string literal binding over a type variable, triggering a CoreLint error when that binding floated to top-level. The solution implemented in this patch fixes this by re-doing dependency analysis on a simplified recursive let binding that is about to be type abstracted, in order to find the minimal set of type variables to abstract over. See wrinkle (AB5) of Note [Floating and type abstraction] for more details. Fixes #24551 - - - - - 8a8ac65a by Matthew Craven at 2024-03-23T00:20:52-04:00 Improve toInteger @Word32 on 64-bit platforms On 64-bit platforms, every Word32 fits in an Int, so we can convert to Int# without having to perform the overflow check integerFromWord# uses internally. - - - - - 0c48f2b9 by Apoorv Ingle at 2024-03-23T00:21:28-04:00 Fix for #24552 (see testcase T24552) Fixes for a bug in desugaring pattern synonyms matches, introduced while working on on expanding `do`-blocks in #18324 The `matchWrapper` unecessarily (and incorrectly) filtered out the default wild patterns in a match. Now the wild pattern alternative is simply ignored by the pm check as its origin is `Generated`. The current code now matches the expected semantics according to the language spec. - - - - - b72705e9 by Simon Peyton Jones at 2024-03-23T00:22:04-04:00 Print more info about kinds in error messages This fixes #24553, where GHC unhelpfully said error: [GHC-83865] • Expected kind ‘* -> * -> *’, but ‘Foo’ has kind ‘* -> * -> *’ See Note [Showing invisible bits of types in error messages] - - - - - 8f7cfc7e by Tristan Cacqueray at 2024-03-23T00:22:44-04:00 docs: remove the don't use float hint This hint is outdated, ``Complex Float`` are now specialised, and the heap space suggestion needs more nuance so it should be explained in the unboxed/storable array documentation. - - - - - 5bd8ed53 by Andreas Klebinger at 2024-03-23T16:18:33-04:00 NCG: Fix a bug in jump shortcutting. When checking if a jump has more than one destination account for the possibility of some jumps not being representable by a BlockId. We do so by having isJumpishInstr return a `Maybe BlockId` where Nothing represents non-BlockId jump destinations. Fixes #24507 - - - - - 8d67f247 by Ben Gamari at 2024-03-23T16:19:09-04:00 docs: Drop old release notes, add for 9.12.1 - - - - - 7db8c992 by Cheng Shao at 2024-03-25T13:45:46-04:00 rts: fix clang compilation on aarch64 This patch fixes function prototypes in ARMOutlineAtomicsSymbols.h which causes "error: address argument to atomic operation must be a pointer to _Atomic type" when compiling with clang on aarch64. - - - - - 237194ce by Sylvain Henry at 2024-03-25T13:46:27-04:00 Lexer: fix imports for Alex 3.5.1 (#24583) - - - - - 810660b7 by Cheng Shao at 2024-03-25T22:19:16-04:00 libffi-tarballs: bump libffi-tarballs submodule to libffi 3.4.6 This commit bumps the libffi-tarballs submodule to libffi 3.4.6, which includes numerous upstream libffi fixes, especially https://github.com/libffi/libffi/issues/760. - - - - - d2ba41e8 by Alan Zimmerman at 2024-03-25T22:19:51-04:00 EPA: do not duplicate comments in signature RHS - - - - - 32a8103f by Rodrigo Mesquita at 2024-03-26T21:16:12-04:00 configure: Use LDFLAGS when trying linkers A user may configure `LDFLAGS` but not `LD`. When choosing a linker, we will prefer `ldd`, then `ld.gold`, then `ld.bfd` -- however, we have to check for a working linker. If either of these fail, we try the next in line. However, we were not considering the `$LDFLAGS` when checking if these linkers worked. So we would pick a linker that does not support the current $LDFLAGS and fail further down the line when we used that linker with those flags. Fixes #24565, where `LDFLAGS=-Wl,-z,pack-relative-relocs` is not supported by `ld.gold` but that was being picked still. - - - - - bf65a7c3 by Rodrigo Mesquita at 2024-03-26T21:16:48-04:00 bindist: Clean xattrs of bin and lib at configure time For issue #21506, we started cleaning the extended attributes of binaries and libraries from the bindist *after* they were installed to workaround notarisation (#17418), as part of `make install`. However, the `ghc-toolchain` binary that is now shipped with the bindist must be run at `./configure` time. Since we only cleaned the xattributes of the binaries and libs after they were installed, in some situations users would be unable to run `ghc-toolchain` from the bindist, failing at configure time (#24554). In this commit we move the xattr cleaning logic to the configure script. Fixes #24554 - - - - - cfeb70d3 by Rodrigo Mesquita at 2024-03-26T21:17:24-04:00 Revert "NCG: Fix a bug in jump shortcutting." This reverts commit 5bd8ed53dcefe10b72acb5729789e19ceb22df66. Fixes #24586 - - - - - 13223f6d by Serge S. Gulin at 2024-03-27T07:28:51-04:00 JS: `h$rts_isProfiled` is removed from `profiling` and left its version at `rts/js/config.js` - - - - - 0acfe391 by Alan Zimmerman at 2024-03-27T07:29:27-04:00 EPA: Do not extend declaration range for trailine zero len semi The lexer inserts virtual semicolons having zero width. Do not use them to extend the list span of items in a list. - - - - - c1a04b8e by Ben Gamari at 2024-04-02T16:42:56-04:00 testsuite: Introduce template-haskell-exports test - - - - - 10 changed files: - .ghcid - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - .gitlab/generate-ci/gen_ci.hs - .gitlab/generate-ci/generate-job-metadata - .gitlab/generate-ci/generate-jobs - .gitlab/issue_templates/bug.md → .gitlab/issue_templates/default.md The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f116f0b61110b2d9b816b12a8a3a4d912bba70b2...c1a04b8edc49486649b788ca8f8d0f60b59fd0a3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f116f0b61110b2d9b816b12a8a3a4d912bba70b2...c1a04b8edc49486649b788ca8f8d0f60b59fd0a3 You're receiving 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 Apr 2 22:44:37 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 02 Apr 2024 18:44:37 -0400 Subject: [Git][ghc/ghc][wip/T23109] 913 commits: Serialize CmmRetInfo in .rodata Message-ID: <660c8a5545d9_f9da3e90a7c960b@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: 7acbf0fd by Sven Tennie at 2023-08-10T19:17:11-04:00 Serialize CmmRetInfo in .rodata The handling of case was missing. - - - - - 0c3136f2 by Sven Tennie at 2023-08-10T19:17:11-04:00 Reference StgRetFun payload by its struct field address This is easier to grasp than relative pointer offsets. - - - - - f68ff313 by Sven Tennie at 2023-08-10T19:17:11-04:00 Better variable name: u -> frame The 'u' was likely introduced by copy'n'paste. - - - - - 0131bb7f by Sven Tennie at 2023-08-10T19:17:11-04:00 Make checkSTACK() public Such that it can also be used in tests. - - - - - 7b6e1e53 by Sven Tennie at 2023-08-10T19:17:11-04:00 Publish stack related fields in DerivedConstants.h These will be used in ghc-heap to decode these parts of the stack. - - - - - 907ed054 by Sven Tennie at 2023-08-10T19:17:11-04:00 ghc-heap: Decode StgStack and its stack frames Previously, ghc-heap could only decode heap closures. The approach is explained in detail in note [Decoding the stack]. - - - - - 6beb6ac2 by Sven Tennie at 2023-08-10T19:17:11-04:00 Remove RetFunType from RetFun stack frame representation It's a technical detail. The single usage is replaced by a predicate. - - - - - 006bb4f3 by Sven Tennie at 2023-08-10T19:17:11-04:00 Better parameter name The call-site uses the term "offset", too. - - - - - d4c2c1af by Sven Tennie at 2023-08-10T19:17:11-04:00 Make closure boxing pure There seems to be no need to do something complicated. However, the strictness of the closure pointer matters, otherwise a thunk gets decoded. - - - - - 8d8426c9 by Sven Tennie at 2023-08-10T19:17:11-04:00 Document entertainGC in test It wasn't obvious why it's there and what its role is. Also, increase the "entertainment level" a bit. I checked in STG and Cmm dumps that this really generates closures (and is not e.g. constant folded away.) - - - - - cc52c358 by Finley McIlwaine at 2023-08-10T19:17:47-04:00 Add -dipe-stats flag This is useful for seeing which info tables have information. - - - - - 261c4acb by Finley McIlwaine at 2023-08-10T19:17:47-04:00 Add -finfo-table-map-with-fallback -finfo-table-map-with-stack The -fno-info-table-map-with-stack flag omits STACK info tables from the info table map, and the -fno-info-table-map-with-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase the build results were about 7% smaller when both of those types of tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats, which is disabled for the js backend since profiling is not implemented. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. This commit also fixes some issues in the users guide rst source to fix warnings that were noticed while debugging the documentation for these flags. Fixes #23702 - - - - - d7047e0d by Jaro Reinders at 2023-08-14T04:41:42-04:00 Add changelog entry for specialised Enum Int64/Word64 instances - - - - - 52f5e8fb by cydparser at 2023-08-14T04:42:20-04:00 Fix -ddump-to-file and -ddump-timings interaction (#20316) - - - - - 1274c5d6 by cydparser at 2023-08-14T04:42:20-04:00 Update release notes (#20316) - - - - - 8e699b23 by Matthew Pickering at 2023-08-14T10:44:47-04:00 base: Add changelog entry for CLC #188 This proposal modified the implementations of copyBytes, moveBytes and fillBytes (as detailed in the proposal) https://github.com/haskell/core-libraries-committee/issues/188 - - - - - 026f040a by Matthew Pickering at 2023-08-14T10:45:23-04:00 packaging: Build manpage in separate directory to other documentation We were installing two copies of the manpage: * One useless one in the `share/doc` folder, because we copy the doc/ folder into share/ * The one we deliberately installed into `share/man` etc The solution is to build the manpage into the `manpage` directory when building the bindist, and then just install it separately. Fixes #23707 - - - - - 524c60c8 by Bartłomiej Cieślar at 2023-08-14T13:46:33-04:00 Report deprecated fields bound by record wildcards when used This commit ensures that we emit the appropriate warnings when a deprecated record field bound by a record wildcard is used. For example: module A where data Foo = Foo {x :: Int, y :: Bool, z :: Char} {-# DEPRECATED x "Don't use x" #-} {-# WARNING y "Don't use y" #-} module B where import A foo (Foo {..}) = x This will cause us to emit a "Don't use x" warning, with location the location of the record wildcard. Note that we don't warn about `y`, because it is unused in the RHS of `foo`. Fixes #23382 - - - - - d6130065 by Matthew Pickering at 2023-08-14T13:47:11-04:00 Add zstd suffix to jobs which rely on zstd This was causing some confusion as the job was named simply "x86_64-linux-deb10-validate", which implies a standard configuration rather than any dependency on libzstd. - - - - - e24e44fc by Matthew Pickering at 2023-08-14T13:47:11-04:00 ci: Always run project-version job This is needed for the downstream test-primops pipeline to workout what the version of a bindist produced by a pipeline is. - - - - - f17b9d62 by Matthew Pickering at 2023-08-14T13:47:11-04:00 gen_ci: Rework how jobs-metadata.json is generated * We now represent a job group a triple of Maybes, which makes it easier to work out when jobs are enabled/disabled on certain pipelines. ``` data JobGroup a = StandardTriple { v :: Maybe (NamedJob a) , n :: Maybe (NamedJob a) , r :: Maybe (NamedJob a) } ``` * `jobs-metadata.json` generation is reworked using the following algorithm. - For each pipeline type, find all the platforms we are doing builds for. - Select one build per platform - Zip together the results This way we can choose different pipelines for validate/nightly/release which makes the metadata also useful for validate pipelines. This feature is used by the test-primops downstream CI in order to select the right bindist for testing validate pipelines. This makes it easier to inspect which jobs are going to be enabled on a particular pipeline. - - - - - f9a5563d by Matthew Pickering at 2023-08-14T13:47:11-04:00 gen_ci: Rules rework In particular we now distinguish between whether we are dealing with a Nightly/Release pipeline (which labels don't matter for) and a validate pipeline where labels do matter. The overall goal here is to allow a disjunction of labels for validate pipelines, for example, > Run a job if we have the full-ci label or test-primops label Therefore the "ValidateOnly" rules are treated as a set of disjunctions rather than conjunctions like before. What this means in particular is that if we want to ONLY run a job if a label is set, for example, "FreeBSD" label then we have to override the whole label set. Fixes #23772 - - - - - d54b0c1d by Matthew Pickering at 2023-08-14T13:47:11-04:00 ci: set -e for lint-ci-config scripts - - - - - 994a9b35 by Matthew Pickering at 2023-08-14T13:47:11-04:00 ci: Fix job metadata generation - - - - - e194ed2b by Ben Gamari at 2023-08-15T00:58:09-04:00 users-guide: Note that GHC2021 doesn't include ExplicitNamespaces As noted in #23801. - - - - - d814bda9 by Ben Gamari at 2023-08-15T05:43:53-04:00 users-guide: Support both distutils and packaging As noted in #23818, some old distributions (e.g. Debian 9) only include `distutils` while newer distributions only include `packaging`. Fixes #23818. - - - - - 1726db3f by Ben Gamari at 2023-08-15T05:43:53-04:00 users-guide: Ensure extlinks is compatible with Sphinx <4 The semantics of the `extlinks` attribute annoyingly changed in Sphinx 4. Reflect this in our configuration. See #22690. Fixes #23807. - - - - - 173338cf by Matthew Pickering at 2023-08-15T22:00:24-04:00 ci: Run full-ci on master and release branches Fixes #23737 - - - - - bdab6898 by Andrew Lelechenko at 2023-08-15T22:01:03-04:00 Add @since pragmas for Data.Ord.clamp and GHC.Float.clamp - - - - - 662d351b by Matthew Pickering at 2023-08-16T09:35:04-04:00 ghc-toolchain: Match CPP args with configure script At the moment we need ghc-toolchain to precisely match the output as provided by the normal configure script. The normal configure script (FP_HSCPP_CMD_WITH_ARGS) branches on whether we are using clang or gcc so we match that logic exactly in ghc-toolchain. The old implementation (which checks if certain flags are supported) is better but for now we have to match to catch any potential errors in the configuration. Ticket: #23720 - - - - - 09c6759e by Matthew Pickering at 2023-08-16T09:35:04-04:00 configure: Fix `-Wl,--no-as-needed` check The check was failing because the args supplied by $$1 were quoted which failed because then the C compiler thought they were an input file. Fixes #23720 - - - - - 2129678b by Matthew Pickering at 2023-08-16T09:35:04-04:00 configure: Add flag which turns ghc-toolchain check into error We want to catch these errors in CI, but first we need to a flag which turns this check into an error. - - - - - 6e2aa8e0 by Matthew Pickering at 2023-08-16T09:35:04-04:00 ci: Enable --enable-strict-ghc-toolchain-check for all CI jobs This will cause any CI job to fail if we have a mismatch between what ghc-toolchain reports and what ./configure natively reports. Fixing these kinds of issues is highest priority for 9.10 release. - - - - - 12d39e24 by Rodrigo Mesquita at 2023-08-16T09:35:04-04:00 Pass user-specified options to ghc-toolchain The current user interface to configuring target toolchains is `./configure`. In !9263 we added a new tool to configure target toolchains called `ghc-toolchain`, but the blessed way of creating these toolchains is still through configure. However, we were not passing the user-specified options given with the `./configure` invocation to the ghc-toolchain tool. This commit remedies that by storing the user options and environment variables in USER_* variables, which then get passed to GHC-toolchain. The exception to the rule is the windows bundled toolchain, which overrides the USER_* variables with whatever flags the windows bundled toolchain requires to work. We consider the bundled toolchain to be effectively the user specifying options, since the actual user delegated that configuration work. Closes #23678 - - - - - f7b3c3a0 by Rodrigo Mesquita at 2023-08-16T09:35:04-04:00 ghc-toolchain: Parse javascript and ghcjs as a Arch and OS - - - - - 8a0ae4ee by Rodrigo Mesquita at 2023-08-16T09:35:04-04:00 ghc-toolchain: Fix ranlib option - - - - - 31e9ec96 by Rodrigo Mesquita at 2023-08-16T09:35:04-04:00 Check Link Works with -Werror - - - - - bc1998b3 by Matthew Pickering at 2023-08-16T09:35:04-04:00 Only check for no_compact_unwind support on darwin While writing ghc-toolchain we noticed that the FP_PROG_LD_NO_COMPACT_UNWIND check is subtly wrong. Specifically, we pass -Wl,-no_compact_unwind to cc. However, ld.gold interprets this as -n o_compact_unwind, which is a valid argument. Fixes #23676 - - - - - 0283f36e by Matthew Pickering at 2023-08-16T09:35:04-04:00 Add some javascript special cases to ghc-toolchain On javascript there isn't a choice of toolchain but some of the configure checks were not accurately providing the correct answer. 1. The linker was reported as gnu LD because the --version output mentioned gnu LD. 2. The --target flag makes no sense on javascript but it was just ignored by the linker, so we add a special case to stop ghc-toolchain thinking that emcc supports --target when used as a linker. - - - - - a48ec5f8 by Matthew Pickering at 2023-08-16T09:35:04-04:00 check for emcc in gnu_LD check - - - - - 50df2e69 by Matthew Pickering at 2023-08-16T09:35:04-04:00 Add ldOverrideWhitelist to only default to ldOverride on windows/linux On some platforms - ie darwin, javascript etc we really do not want to allow the user to use any linker other than the default one as this leads to all kinds of bugs. Therefore it is a bit more prudant to add a whitelist which specifies on which platforms it might be possible to use a different linker. - - - - - a669a39c by Matthew Pickering at 2023-08-16T09:35:04-04:00 Fix plaform glob in FPTOOLS_SET_C_LD_FLAGS A normal triple may look like x86_64-unknown-linux but when cross-compiling you get $target set to a quad such as.. aarch64-unknown-linux-gnu Which should also match this check. - - - - - c52b6769 by Matthew Pickering at 2023-08-16T09:35:04-04:00 ghc-toolchain: Pass ld-override onto ghc-toolchain - - - - - 039b484f by Matthew Pickering at 2023-08-16T09:35:04-04:00 ld override: Make whitelist override user given option - - - - - d2b63cbc by Matthew Pickering at 2023-08-16T09:35:05-04:00 ghc-toolchain: Add format mode to normalise differences before diffing. The "format" mode takes an "--input" and "--ouput" target file and formats it. This is intended to be useful on windows where the configure/ghc-toolchain target files can't be diffed very easily because the path separators are different. - - - - - f2b39e4a by Matthew Pickering at 2023-08-16T09:35:05-04:00 ghc-toolchain: Bump ci-images commit to get new ghc-wasm-meta We needed to remove -Wno-unused-command-line-argument from the arguments passed in order for the configure check to report correctly. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10976#note_516335 - - - - - 92103830 by Matthew Pickering at 2023-08-16T09:35:05-04:00 configure: MergeObjsCmd - distinguish between empty string and unset variable If `MergeObjsCmd` is explicitly set to the empty string then we should assume that MergeObjs is just not supported. This is especially important for windows where we set MergeObjsCmd to "" in m4/fp_setup_windows_toolchain.m4. - - - - - 3500bb2c by Matthew Pickering at 2023-08-16T09:35:05-04:00 configure: Add proper check to see if object merging works - - - - - 08c9a014 by Matthew Pickering at 2023-08-16T09:35:05-04:00 ghc-toolchain: If MergeObjsCmd is not set, replace setting with Nothing If the user explicitly chooses to not set a MergeObjsCmd then it is correct to use Nothing for tgtMergeObjs field in the Target file. - - - - - c9071d94 by Matthew Pickering at 2023-08-16T09:35:05-04:00 HsCppArgs: Augment the HsCppOptions This is important when we pass -I when setting up the windows toolchain. - - - - - 294a6d80 by Matthew Pickering at 2023-08-16T09:35:05-04:00 Set USER_CPP_ARGS when setting up windows toolchain - - - - - bde4b5d4 by Rodrigo Mesquita at 2023-08-16T09:35:05-04:00 Improve handling of Cc as a fallback - - - - - f4c1c3a3 by Rodrigo Mesquita at 2023-08-16T09:35:05-04:00 ghc-toolchain: Configure Cpp and HsCpp correctly when user specifies flags In ghc-toolchain, we were only /not/ configuring required flags when the user specified any flags at all for the of the HsCpp and Cpp tools. Otherwise, the linker takes into consideration the user specified flags to determine whether to search for a better linker implementation, but already configured the remaining GHC and platform-specific flags regardless of the user options. Other Tools consider the user options as a baseline for further configuration (see `findProgram`), so #23689 is not applicable. Closes #23689 - - - - - bfe4ffac by Matthew Pickering at 2023-08-16T09:35:05-04:00 CPP_ARGS: Put new options after user specified options This matches up with the behaviour of ghc-toolchain, so that the output of both matches. - - - - - a6828173 by Gergő Érdi at 2023-08-16T09:35:41-04:00 If a defaulting plugin made progress, re-zonk wanteds before built-in defaulting Fixes #23821. - - - - - e2b38115 by Sylvain Henry at 2023-08-17T07:54:06-04:00 JS: implement openat(AT_FDCWD...) (#23697) Use `openSync` to implement `openat(AT_FDCWD...)`. - - - - - a975c663 by sheaf at 2023-08-17T07:54:47-04:00 Use unsatisfiable for missing methods w/ defaults When a class instance has an Unsatisfiable constraint in its context and the user has not explicitly provided an implementation of a method, we now always provide a RHS of the form `unsatisfiable @msg`, even if the method has a default definition available. This ensures that, when deferring type errors, users get the appropriate error message instead of a possible runtime loop, if class default methods were defined recursively. Fixes #23816 - - - - - 45ca51e5 by Ben Gamari at 2023-08-17T15:16:41-04:00 ghc-internal: Initial commit of the skeleton - - - - - 88bbf8c5 by Ben Gamari at 2023-08-17T15:16:41-04:00 ghc-experimental: Initial commit - - - - - 664468c0 by Ben Gamari at 2023-08-17T15:17:17-04:00 testsuite/cloneStackLib: Fix incorrect format specifiers - - - - - eaa835bb by Ben Gamari at 2023-08-17T15:17:17-04:00 rts/ipe: Fix const-correctness of IpeBufferListNode Both info tables and the string table should be `const` - - - - - 78f6f6fd by Ben Gamari at 2023-08-17T15:17:17-04:00 nonmoving: Drop dead debugging utilities These are largely superceded by support in the ghc-utils GDB extension. - - - - - 3f6e8f42 by Ben Gamari at 2023-08-17T15:17:17-04:00 nonmoving: Refactor management of mark thread Here we refactor that treatment of the worker thread used by the nonmoving GC for concurrent marking, avoiding creating a new thread with every major GC cycle. As well, the new scheme is considerably easier to reason about, consolidating all state in one place, accessed via a small set of accessors with clear semantics. - - - - - 88c32b7d by Ben Gamari at 2023-08-17T15:17:17-04:00 testsuite: Skip T23221 in nonmoving GC ways This test is very dependent upon GC behavior. - - - - - 381cfaed by Ben Gamari at 2023-08-17T15:17:17-04:00 ghc-heap: Don't expose stack dirty and marking fields These are GC metadata and are not relevant to the end-user. Moreover, they are unstable which makes ghc-heap harder to test than necessary. - - - - - 16828ca5 by Luite Stegeman at 2023-08-21T18:42:53-04:00 bump process submodule to include macOS fix and JS support - - - - - b4d5f6ed by Matthew Pickering at 2023-08-21T18:43:29-04:00 ci: Add support for triggering test-primops pipelines This commit adds 4 ways to trigger testing with test-primops. 1. Applying the ~test-primops label to a validate pipeline. 2. A manually triggered job on a validate pipeline 3. A nightly pipeline job 4. A release pipeline job Fixes #23695 - - - - - 32c50daa by Matthew Pickering at 2023-08-21T18:43:29-04:00 Add test-primops label support The test-primops CI job requires some additional builds in the validation pipeline, so we make sure to enable these jobs when test-primops label is set. - - - - - 73ca8340 by Matthew Pickering at 2023-08-21T18:43:29-04:00 Revert "Aarch ncg: Optimize immediate use for address calculations" This reverts commit 8f3b3b78a8cce3bd463ed175ee933c2aabffc631. See #23793 - - - - - 5546ad9e by Matthew Pickering at 2023-08-21T18:43:29-04:00 Revert "AArch NCG: Pure refactor" This reverts commit 00fb6e6b06598752414a0b9a92840fb6ca61338d. See #23793 - - - - - 02dfcdc2 by Matthew Pickering at 2023-08-21T18:43:29-04:00 Revert "Aarch64 NCG: Use encoded immediates for literals." This reverts commit 40425c5021a9d8eb5e1c1046e2d5fa0a2918f96c. See #23793 ------------------------- Metric Increase: T4801 T5321FD T5321Fun ------------------------- - - - - - 7be4a272 by Matthew Pickering at 2023-08-22T08:55:20+01:00 ci: Remove manually triggered test-ci job This doesn't work on slimmed down pipelines as the needed jobs don't exist. If you want to run test-primops then apply the label. - - - - - 76a4d11b by Jaro Reinders at 2023-08-22T08:08:13-04:00 Remove Ptr example from roles docs - - - - - 069729d3 by Bryan Richter at 2023-08-22T08:08:49-04:00 Guard against duplicate pipelines in forks - - - - - f861423b by Rune K. Svendsen at 2023-08-22T08:09:35-04:00 dump-decls: fix "Ambiguous module name"-error Fixes errors of the following kind, which happen when dump-decls is run on a package that contains a module name that clashes with that of another package. ``` dump-decls: <no location info>: error: Ambiguous module name `System.Console.ANSI.Types': it was found in multiple packages: ansi-terminal-0.11.4 ansi-terminal-types-0.11.5 ``` - - - - - edd8bc43 by Krzysztof Gogolewski at 2023-08-22T12:31:20-04:00 Fix MultiWayIf linearity checking (#23814) Co-authored-by: Thomas BAGREL <thomas.bagrel at tweag.io> - - - - - 4ba088d1 by konsumlamm at 2023-08-22T12:32:02-04:00 Update `Control.Concurrent.*` documentation - - - - - 015886ec by ARATA Mizuki at 2023-08-22T15:13:13-04:00 Support 128-bit SIMD on AArch64 via LLVM backend - - - - - 52a6d868 by Krzysztof Gogolewski at 2023-08-22T15:13:51-04:00 Testsuite cleanup - Remove misleading help text in perf_notes, ways are not metrics - Remove no_print_summary - this was used for Phabricator - In linters tests, run 'git ls-files' just once. Previously, it was called on each has_ls_files() - Add ghc-prim.cabal to gitignore, noticed in #23726 - Remove ghc-prim.cabal, it was accidentally committed in 524c60c8cd - - - - - ab40aa52 by Alan Zimmerman at 2023-08-22T15:14:28-04:00 EPA: Use Introduce [DeclTag] in AnnSortKey The AnnSortKey is used to keep track of the order of declarations for printing when the container has split them apart. This applies to HsValBinds and ClassDecl, ClsInstDecl. When making modifications to the list of declarations, the new order must be captured for when it must be printed. For each list of declarations (binds and sigs for a HsValBind) we can just store the list in order. To recreate the list when printing, we must merge them, and this is what the AnnSortKey records. It used to be indexed by SrcSpan, we now simply index by a marker as to which list to take the next item from. - - - - - e7db36c1 by sheaf at 2023-08-23T08:41:28-04:00 Don't attempt pattern synonym error recovery This commit gets rid of the pattern synonym error recovery mechanism (recoverPSB). The rationale is that the fake pattern synonym binding that the recovery mechanism introduced could lead to undesirable knock-on errors, and it isn't really feasible to conjure up a satisfactory binding as pattern synonyms can be used both in expressions and patterns. See Note [Pattern synonym error recovery] in GHC.Tc.TyCl.PatSyn. It isn't such a big deal to eagerly fail compilation on a pattern synonym that doesn't typecheck anyway. Fixes #23467 - - - - - 6ccd9d65 by Ben Gamari at 2023-08-23T08:42:05-04:00 base: Don't use Data.ByteString.Internals.memcpy This function is now deprecated from `bytestring`. Use `Foreign.Marshal.Utils.copyBytes` instead. Fixes #23880. - - - - - 0bfa0031 by Matthew Pickering at 2023-08-23T13:43:48-04:00 hadrian: Uniformly pass buildOptions to all builders in runBuilder In Builder.hs, runBuilderWith mostly ignores the buildOptions in BuildInfo. This leads to hard to diagnose bugs as any build options you pass with runBuilderWithCmdOptions are ignored for many builders. Solution: Uniformly pass buildOptions to the invocation of cmd. Fixes #23845 - - - - - 9cac8f11 by Matthew Pickering at 2023-08-23T13:43:48-04:00 Abstract windows toolchain setup This commit splits up the windows toolchain setup logic into two functions. * FP_INSTALL_WINDOWS_TOOLCHAIN - deals with downloading the toolchain if it isn't already downloaded * FP_SETUP_WINDOWS_TOOLCHAIN - sets the environment variables to point to the correct place FP_SETUP_WINDOWS_TOOLCHAIN is abstracted from the location of the mingw toolchain and also the eventual location where we will install the toolchain in the installed bindist. This is the first step towards #23608 - - - - - 6c043187 by Matthew Pickering at 2023-08-23T13:43:48-04:00 Generate build.mk for bindists The config.mk.in script was relying on some variables which were supposed to be set by build.mk but therefore never were when used to install a bindist. Specifically * BUILD_PROF_LIBS to determine whether we had profiled libraries or not * DYNAMIC_GHC_PROGRAMS to determine whether we had shared libraries or not Not only were these never set but also not really accurate because you could have shared libaries but still statically linked ghc executable. In addition variables like GhcLibWays were just never used, so those have been deleted from the script. Now instead we generate a build.mk file which just directly specifies which RtsWays we have supplied in the bindist and whether we have DYNAMIC_GHC_PROGRAMS. - - - - - fe23629b by Matthew Pickering at 2023-08-23T13:43:48-04:00 hadrian: Add reloc-binary-dist-* targets This adds a command line option to build a "relocatable" bindist. The bindist is created by first creating a normal bindist and then installing it using the `RelocatableBuild=YES` option. This creates a bindist without any wrapper scripts pointing to the libdir. The motivation for this feature is that we want to ship relocatable bindists on windows and this method is more uniform than the ad-hoc method which lead to bugs such as #23608 and #23476 The relocatable bindist can be built with the "reloc-binary-dist" target and supports the same suffixes as the normal "binary-dist" command to specify the compression style. - - - - - 41cbaf44 by Matthew Pickering at 2023-08-23T13:43:48-04:00 packaging: Fix installation scripts on windows/RelocatableBuild case This includes quite a lot of small fixes which fix the installation makefile to work on windows properly. This also required fixing the RelocatableBuild variable which seemed to have been broken for a long while. Sam helped me a lot writing this patch by providing a windows machine to test the changes. Without him it would have taken ages to tweak everything. Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - 03474456 by Matthew Pickering at 2023-08-23T13:43:48-04:00 ci: Build relocatable bindist on windows We now build the relocatable bindist target on windows, which means we test and distribute the new method of creating a relocatable bindist. - - - - - d0b48113 by Matthew Pickering at 2023-08-23T13:43:48-04:00 hadrian: Add error when trying to build binary-dist target on windows The binary dist produced by `binary-dist` target doesn't work on windows because of the wrapper script the makefile installs. In order to not surprise any packagers we just give an error if someone tries to build the old binary-dist target rather than the reloc-binary-dist target. - - - - - 7cbf9361 by Matthew Pickering at 2023-08-23T13:43:48-04:00 hadrian: Remove query' logic to use tooldir - - - - - 03fad42e by Matthew Pickering at 2023-08-23T13:43:48-04:00 configure: Set WindresCmd directly and removed unused variables For some reason there was an indirection via the Windres variable before setting WindresCmd. That indirection led to #23855. I then also noticed that these other variables were just not used anywhere when trying to work out what the correct condition was for this bit of the configure script. - - - - - c82770f5 by sheaf at 2023-08-23T13:43:48-04:00 Apply shellcheck suggestion to SUBST_TOOLDIR - - - - - 896e35e5 by sheaf at 2023-08-23T13:44:34-04:00 Compute hints from TcSolverReportMsg This commit changes how hints are handled in conjunction with constraint solver report messages. Instead of storing `[GhcHint]` in the TcRnSolverReport error constructor, we compute the hints depending on the underlying TcSolverReportMsg. This disentangles the logic and makes it easier to add new hints for certain errors. - - - - - a05cdaf0 by Alexander Esgen at 2023-08-23T13:45:16-04:00 users-guide: remove note about fatal Haddock parse failures - - - - - 4908d798 by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Introduce Data.Enum - - - - - f59707c7 by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add export list to GHC.Num.Integer - - - - - b1054053 by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add export list to GHC.Num - - - - - 6baa481d by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add export list to GHC.Num.Natural - - - - - 2ac15233 by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add export list to GHC.Float - - - - - f3c489de by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add export list to GHC.Real - - - - - 94f59eaa by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Eliminate module reexport in GHC.Exception The metric increase here isn't strictly due to this commit but it's a rather small, incidental change. Metric Increase: T8095 T13386 Metric Decrease: T8095 T13386 T18304 - - - - - be1fc7df by Ben Gamari at 2023-08-23T17:36:41-04:00 base: Add disclaimers in internal modules To warn users that these modules are internal and their interfaces may change with little warning. As proposed in Core Libraries Committee #146 [CLC146]. [CLC146]: https://github.com/haskell/core-libraries-committee/issues/146 - - - - - 0326f3f4 by sheaf at 2023-08-23T17:37:29-04:00 Bump Cabal submodule We need to bump the Cabal submodule to include commit ec75950 which fixes an issue with a dodgy import Rep(..) which relied on GHC bug #23570 - - - - - 0504cd08 by Facundo Domínguez at 2023-08-23T17:38:11-04:00 Fix typos in the documentation of Data.OldList.permutations - - - - - 1420b8cb by Antoine Leblanc at 2023-08-24T16:18:17-04:00 Be more eager in TyCon boot validity checking This commit performs boot-file consistency checking for TyCons into checkValidTyCl. This ensures that we eagerly catch any mismatches, which prevents the compiler from seeing these inconsistencies and panicking as a result. See Note [TyCon boot consistency checking] in GHC.Tc.TyCl. Fixes #16127 - - - - - d99c816f by Finley McIlwaine at 2023-08-24T16:18:55-04:00 Refactor estimation of stack info table provenance This commit greatly refactors the way we compute estimated provenance for stack info tables. Previously, this process was done using an entirely separate traversal of the whole Cmm code stream to build the map from info tables to source locations. The separate traversal is now fused with the Cmm code generation pipeline in GHC.Driver.Main. This results in very significant code generation speed ups when -finfo-table-map is enabled. In testing, this patch reduces code generation times by almost 30% with -finfo-table-map and -O0, and 60% with -finfo-table-map and -O1 or -O2 . Fixes #23103 - - - - - d3e0124c by Finley McIlwaine at 2023-08-24T16:18:55-04:00 Add a test checking overhead of -finfo-table-map We want to make sure we don't end up with poor codegen performance resulting from -finfo-table-map again as in #23103. This test adds a performance test tracking total allocations while compiling ExactPrint with -finfo-table-map. - - - - - fcfc1777 by Ben Gamari at 2023-08-25T10:58:16-04:00 llvmGen: Add export list to GHC.Llvm.MetaData - - - - - 5880fff6 by Ben Gamari at 2023-08-25T10:58:16-04:00 llvmGen: Allow LlvmLits in MetaExprs This omission appears to be an oversight. - - - - - 86ce92a2 by Ben Gamari at 2023-08-25T10:58:16-04:00 compiler: Move platform feature predicates to GHC.Driver.DynFlags These are useful in `GHC.Driver.Config.*`. - - - - - a6a38742 by Ben Gamari at 2023-08-25T10:58:16-04:00 llvmGen: Introduce infrastructure for module flag metadata - - - - - e9af2cf3 by Ben Gamari at 2023-08-25T10:58:16-04:00 llvmGen: Don't pass stack alignment via command line As of https://reviews.llvm.org/D103048 LLVM no longer supports the `-stack-alignment=...` flag. Instead this information is passed via a module flag metadata node. This requires dropping support for LLVM 11 and 12. Fixes #23870 - - - - - a936f244 by Alan Zimmerman at 2023-08-25T10:58:56-04:00 EPA: Keep track of "in" token for WarningTxt category A warning can now be written with a category, e.g. {-# WARNInG in "x-c" e "d" #-} Keep track of the location of the 'in' keyword and string, as well as the original SourceText of the label, in case it uses character escapes. - - - - - 3df8a653 by Matthew Pickering at 2023-08-25T17:42:18-04:00 Remove redundant import in InfoTableProv The copyBytes function is provided by the import of Foreign. Fixes #23889 - - - - - d6f807ec by Ben Gamari at 2023-08-25T17:42:54-04:00 gitlab/issue-template: Mention report-a-bug - - - - - 50b9f75d by Artin Ghasivand at 2023-08-26T20:02:50+03:30 Added StandaloneKindSignature examples to replace CUSKs ones - - - - - 2f6309a4 by Vladislav Zavialov at 2023-08-27T03:47:37-04:00 Remove outdated CPP in compiler/* and template-haskell/* The boot compiler was bumped to 9.4 in cebb5819b43. There is no point supporting older GHC versions with CPP. - - - - - 5248fdf7 by Zubin Duggal at 2023-08-28T15:01:09+05:30 testsuite: Add regression test for #23861 Simon says this was fixed by commit 8d68685468d0b6e922332a3ee8c7541efbe46137 Author: sheaf <sam.derbyshire at gmail.com> Date: Fri Aug 4 15:28:45 2023 +0200 Remove zonk in tcVTA - - - - - b6903f4d by Zubin Duggal at 2023-08-28T12:33:58-04:00 testsuite: Add regression test for #23864 Simon says this was fixed by commit 59202c800f2c97c16906120ab2561f6e1556e4af Author: Sebastian Graf <sebastian.graf at kit.edu> Date: Fri Mar 31 17:35:22 2023 +0200 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. - - - - - 9eecdf33 by sheaf at 2023-08-28T18:54:06+00:00 Remove ScopedTypeVariables => TypeAbstractions This commit implements [amendment 604](https://github.com/ghc-proposals/ghc-proposals/pull/604/) to [GHC proposal 448](https://github.com/ghc-proposals/ghc-proposals/pull/448) by removing the implication of language extensions ScopedTypeVariables => TypeAbstractions To limit breakage, we now allow type arguments in constructor patterns when both ScopedTypeVariables and TypeApplications are enabled, but we emit a warning notifying the user that this is deprecated behaviour that will go away starting in GHC 9.12. Fixes #23776 - - - - - fadd5b4d by sheaf at 2023-08-28T18:54:06+00:00 .stderr: ScopedTypeVariables =/> TypeAbstractions This commit accepts testsuite changes for the changes in the previous commit, which mean that TypeAbstractions is no longer implied by ScopedTypeVariables. - - - - - 4f5fb500 by Greg Steuck at 2023-08-29T07:55:13-04:00 Repair `codes` test on OpenBSD by explicitly requesting extended RE - - - - - 6bbde581 by Vasily Sterekhov at 2023-08-29T12:06:58-04:00 Add test for #23540 `T23540.hs` makes use of `explainEv` from `HieQueries.hs`, so `explainEv` has been moved to `TestUtils.hs`. - - - - - 257bb3bd by Vasily Sterekhov at 2023-08-29T12:06:58-04:00 Add test for #23120 - - - - - 4f192947 by Vasily Sterekhov at 2023-08-29T12:06:58-04:00 Make some evidence uses reachable by toHie Resolves #23540, #23120 This adds spans to certain expressions in the typechecker and renamer, and lets 'toHie' make use of those spans. Therefore the relevant evidence uses for the following syntax will now show up under the expected nodes in 'HieAst's: - Overloaded literals ('IsString', 'Num', 'Fractional') - Natural patterns and N+k patterns ('Eq', 'Ord', and instances from the overloaded literals being matched on) - Arithmetic sequences ('Enum') - Monadic bind statements ('Monad') - Monadic body statements ('Monad', 'Alternative') - ApplicativeDo ('Applicative', 'Functor') - Overloaded lists ('IsList') Also see Note [Source locations for implicit function calls] In the process of handling overloaded lists I added an extra 'SrcSpan' field to 'VAExpansion' - this allows us to more accurately reconstruct the locations from the renamer in 'rebuildHsApps'. This also happens to fix #23120. See the additions to Note [Looking through HsExpanded] - - - - - fe9fcf9d by Sylvain Henry at 2023-08-29T12:07:50-04:00 ghc-heap: rename C file (fix #23898) - - - - - b60d6576 by Krzysztof Gogolewski at 2023-08-29T12:08:29-04:00 Misc cleanup - Builtin.PrimOps: ReturnsAlg was used only for unboxed tuples. Rename to ReturnsTuple. - Builtin.Utils: use SDoc for a panic message. The comment about <<details unavailable>> was obsoleted by e8d356773b56. - TagCheck: fix wrong logic. It was zipping a list 'args' with its version 'args_cmm' after filtering. - Core.Type: remove an outdated 1999 comment about unlifted polymorphic types - hadrian: remove leftover debugging print - - - - - 3054fd6d by Krzysztof Gogolewski at 2023-08-29T12:09:08-04:00 Add a regression test for #23903 The bug has been fixed by commit bad2f8b8aa8424. - - - - - 21584b12 by Ben Gamari at 2023-08-29T19:52:02-04:00 README: Refer to ghc-hq repository for contributor and governance information - - - - - e542d590 by sheaf at 2023-08-29T19:52:40-04:00 Export setInertSet from GHC.Tc.Solver.Monad We used to export getTcSInerts and setTcSInerts from GHC.Tc.Solver.Monad. These got renamed to getInertSet/setInertSet in e1590ddc. That commit also removed the export of setInertSet, but that function is useful for the GHC API. - - - - - 694ec5b1 by sheaf at 2023-08-30T10:18:32-04:00 Don't bundle children for non-parent Avails We used to bundle all children of the parent Avail with things that aren't the parent, e.g. with class C a where type T a meth :: .. we would bundle the whole Avail (C, T, meth) with all of C, T and meth, instead of only with C. Avoiding this fixes #23570 - - - - - d926380d by Krzysztof Gogolewski at 2023-08-30T10:19:08-04:00 Fix typos - - - - - d07080d2 by Josh Meredith at 2023-08-30T19:42:32-04:00 JS: Implement missing C functions `rename`, `realpath`, and `getcwd` (#23806) - - - - - e2940272 by David Binder at 2023-08-30T19:43:08-04:00 Bump submodules of hpc and hpc-bin to version 0.7.0.0 hpc 0.7.0.0 dropped SafeHaskell safety guarantees in order to simplify compatibility with newer versions of the directory package which dropped all SafeHaskell guarantees. - - - - - 5d56d05c by David Binder at 2023-08-30T19:43:08-04:00 Bump hpc bound in ghc.cabal.in - - - - - 99fff496 by Dominik Schrempf at 2023-08-31T00:04:46-04:00 ghc classes documentation: rm redundant comment - - - - - fe021bab by Dominik Schrempf at 2023-08-31T00:04:46-04:00 prelude documentation: various nits - - - - - 48c84547 by Dominik Schrempf at 2023-08-31T00:04:46-04:00 integer documentation: minor corrections - - - - - 20cd12f4 by Dominik Schrempf at 2023-08-31T00:04:46-04:00 real documentation: nits - - - - - dd39bdc0 by sheaf at 2023-08-31T00:05:27-04:00 Add a test for #21765 This issue (of reporting a constraint as being redundant even though removing it causes typechecking to fail) was fixed in aed1974e. This commit simply adds a regression test. Fixes #21765 - - - - - f1ec3628 by Andrew Lelechenko at 2023-08-31T23:53:30-04:00 Export foldl' from Prelude and bump submodules See https://github.com/haskell/core-libraries-committee/issues/167 for discussion Metric Decrease: T8095 T13386 Metric Increase: T13386 T8095 T8095 ghc/alloc decreased on x86_64, but increased on aarch64. T13386 ghc/alloc decreased on x86_64-windows, but increased on other platforms. Neither has anything to do with `foldl'`, so I conclude that both are flaky. - - - - - 3181b97d by Gergő Érdi at 2023-08-31T23:54:06-04:00 Allow cross-tyvar defaulting proposals from plugins Fixes #23832. - - - - - e4af506e by Sebastian Graf at 2023-09-01T14:29:12-04:00 Clarify Note [GlobalId/LocalId] after CorePrep (#23797) Fixes #23797. - - - - - ac29787c by Sylvain Henry at 2023-09-01T14:30:02-04:00 Fix warning with UNPACK on sum type (#23921) - - - - - 9765ac7b by Zubin Duggal at 2023-09-05T00:37:45-04:00 hadrian: track python dependencies in doc rules - - - - - 1578215f by sheaf at 2023-09-05T00:38:26-04:00 Bump Haddock to fix #23616 This commit updates the Haddock submodule to include the fix to #23616. Fixes #23616 - - - - - 5a2fe35a by David Binder at 2023-09-05T00:39:07-04:00 Fix example in GHC user guide in SafeHaskell section The example given in the SafeHaskell section uses an implementation of Monad which no longer works. This MR removes the non-canonical return instance and adds the necessary instances of Functor and Applicative. - - - - - 291d81ae by Matthew Pickering at 2023-09-05T14:03:10-04:00 driver: Check transitive closure of haskell package dependencies when deciding whether to relink We were previously just checking whether direct package dependencies had been modified. This caused issues when compiling without optimisations as we wouldn't relink the direct dependency if one of its dependenices changed. Fixes #23724 - - - - - 35da0775 by Krzysztof Gogolewski at 2023-09-05T14:03:47-04:00 Re-export GHC.Utils.Panic.Plain from GHC.Utils.Panic Fixes #23930 - - - - - 3930d793 by Jaro Reinders at 2023-09-06T18:42:55-04:00 Make STG rewriter produce updatable closures - - - - - 0104221a by Krzysztof Gogolewski at 2023-09-06T18:43:32-04:00 configure: update message to use hadrian (#22616) - - - - - b34f8586 by Alan Zimmerman at 2023-09-07T10:58:38-04:00 EPA: Incorrect locations for UserTyVar with '@' In T13343.hs, the location for the @ is not within the span of the surrounding UserTyVar. type Bad @v = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v Widen it so it is captured. Closes #23887 - - - - - 8046f020 by Finley McIlwaine at 2023-09-07T10:59:15-04:00 Bump haddock submodule to fix #23920 Removes the fake export of `FUN` from Prelude. Fixes #23920. Bumps haddock submodule. - - - - - e0aa8c6e by Krzysztof Gogolewski at 2023-09-07T11:00:03-04:00 Fix wrong role in mkSelCo_maybe In the Lint failure in #23938, we start with a coercion Refl :: T a ~R T a, and call mkSelCo (SelTyCon 1 nominal) Refl. The function incorrectly returned Refl :: a ~R a. The returned role should be nominal, according to the SelCo rule: co : (T s1..sn) ~r0 (T t1..tn) r = tyConRole tc r0 i ---------------------------------- SelCo (SelTyCon i r) : si ~r ti In this test case, r is nominal while r0 is representational. - - - - - 1d92f2df by Gergő Érdi at 2023-09-08T04:04:30-04:00 If we have multiple defaulting plugins, then we should zonk in between them after any defaulting has taken place, to avoid a defaulting plugin seeing a metavariable that has already been filled. Fixes #23821. - - - - - eaee4d29 by Gergő Érdi at 2023-09-08T04:04:30-04:00 Improvements to the documentation of defaulting plugins Based on @simonpj's draft and comments in !11117 - - - - - ede3df27 by Alan Zimmerman at 2023-09-08T04:05:06-04:00 EPA: Incorrect span for LWarnDec GhcPs The code (from T23465.hs) {-# WARNInG in "x-c" e "d" #-} e = e gives an incorrect span for the LWarnDecl GhcPs Closes #23892 It also fixes the Test23465/Test23464 mixup - - - - - a0ccef7a by Krzysztof Gogolewski at 2023-09-08T04:05:42-04:00 Valid hole fits: don't suggest unsafeCoerce (#17940) - - - - - 88b942c4 by Oleg Grenrus at 2023-09-08T19:58:42-04:00 Add warning for badly staged types. Resolves #23829. The stage violation results in out-of-bound names in splices. Technically this is an error, but someone might rely on this!? Internal changes: - we now track stages for TyVars. - thLevel (RunSplice _) = 0, instead of panic, as reifyInstances does in fact rename its argument type, and it can contain variables. - - - - - 9861f787 by Ben Gamari at 2023-09-08T19:59:19-04:00 rts: Fix invalid symbol type I suspect this code is dead since we haven't observed this failing despite the obviously incorrect macro name. - - - - - 03ed6a9a by Ben Gamari at 2023-09-08T19:59:19-04:00 testsuite: Add simple test exercising C11 atomics in GHCi See #22012. - - - - - 1aa5733a by Ben Gamari at 2023-09-08T19:59:19-04:00 rts/RtsSymbols: Add AArch64 outline atomic operations Fixes #22012 by adding the symbols described in https://github.com/llvm/llvm-project/blob/main/llvm/docs/Atomics.rst#libcalls-atomic. Ultimately this would be better addressed by #22011, but this is a first step in the right direction and fixes the immediate symptom. Note that we dropped the `__arch64_cas16` operations as these provided by all platforms's compilers. Also, we don't link directly against the libgcc/compiler-rt definitions but rather provide our own wrappers to work around broken toolchains (e.g. https://bugs.gentoo.org/868018). Generated via https://gitlab.haskell.org/ghc/ghc/-/snippets/5733. - - - - - 8f7d3041 by Matthew Pickering at 2023-09-08T19:59:55-04:00 ci: Build debian12 and fedora38 bindists This adds builds for the latest releases for fedora and debian We build these bindists in nightly and release pipelines. - - - - - a1f0d55c by Felix Leitz at 2023-09-08T20:00:37-04:00 Fix documentation around extension implication for MultiParamTypeClasses/ConstrainedClassMethods. - - - - - 98166389 by Teo Camarasu at 2023-09-12T04:30:54-04:00 docs: move -xn flag beside --nonmoving-gc It makes sense to have these beside each other as they are aliases. - - - - - f367835c by Teo Camarasu at 2023-09-12T04:30:55-04:00 nonmoving: introduce a family of dense allocators Supplement the existing power 2 sized nonmoving allocators with a family of dense allocators up to a configurable threshold. This should reduce waste from rounding up block sizes while keeping the amount of allocator sizes manageable. This patch: - Adds a new configuration option `--nonmoving-dense-allocator-count` to control the amount of these new dense allocators. - Adds some constants to `NonmovingAllocator` in order to keep marking fast with the new allocators. Resolves #23340 - - - - - 2b07bf2e by Teo Camarasu at 2023-09-12T04:30:55-04:00 Add changelog entry for #23340 - - - - - f96fe681 by sheaf at 2023-09-12T04:31:44-04:00 Use printGhciException in run{Stmt, Decls} When evaluating statements in GHCi, we need to use printGhciException instead of the printException function that GHC provides in order to get the appropriate error messages that are customised for ghci use. - - - - - d09b932b by psilospore at 2023-09-12T04:31:44-04:00 T23686: Suggest how to enable Language Extension when in ghci Fixes #23686 - - - - - da30f0be by Matthew Craven at 2023-09-12T04:32:24-04:00 Unarise: Split Rubbish literals in function args Fixes #23914. Also adds a check to STG lint that these args are properly unary or nullary after unarisation - - - - - 261b6747 by Matthew Pickering at 2023-09-12T04:33:04-04:00 darwin: Bump MAXOSX_DEPLOYMENT_TARGET to 10.13 This bumps the minumum supported version to 10.13 (High Sierra) which is 6 years old at this point. Fixes #22938 - - - - - f418f919 by Mario Blažević at 2023-09-12T04:33:45-04:00 Fix TH pretty-printing of nested GADTs, issue #23937 This commit fixes `Language.Haskell.TH.Ppr.pprint` so that it correctly pretty-prints GADTs declarations contained within data family instances. Fixes #23937 - - - - - d7a64753 by John Ericson at 2023-09-12T04:34:20-04:00 Put hadrian non-bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. This is picking up where ad8cfed4195b1bbfc15b841f010e75e71f63157d left off. - - - - - ff0a709a by Sylvain Henry at 2023-09-12T08:46:28-04:00 JS: fix some tests - Tests using Setup programs need to pass --with-hc-pkg - Several other fixes See https://gitlab.haskell.org/ghc/ghc/-/wikis/javascript-backend/bug_triage for the current status - - - - - fc86f0e7 by Krzysztof Gogolewski at 2023-09-12T08:47:04-04:00 Fix in-scope set assertion failure (#23918) Patch by Simon - - - - - 21a906c2 by Matthew Pickering at 2023-09-12T17:21:04+02:00 Add -Winconsistent-flags warning The warning fires when inconsistent command line flags are passed. For example: * -dynamic-too and -dynamic * -dynamic-too on windows * -O and --interactive * etc This is on by default and allows users to control whether the warning is displayed and whether it should be an error or not. Fixes #22572 - - - - - dfc4f426 by Krzysztof Gogolewski at 2023-09-12T20:31:35-04:00 Avoid serializing BCOs with the internal interpreter Refs #23919 - - - - - 9217950b by Finley McIlwaine at 2023-09-13T08:06:03-04:00 Fix numa auto configure - - - - - 98e7c1cf by Simon Peyton Jones at 2023-09-13T08:06:40-04:00 Add -fno-cse to T15426 and T18964 This -fno-cse change is to avoid these performance tests depending on flukey CSE stuff. Each contains several independent tests, and we don't want them to interact. See #23925. By killing CSE we expect a 400% increase in T15426, and 100% in T18964. Metric Increase: T15426 T18964 - - - - - 236a134e by Simon Peyton Jones at 2023-09-13T08:06:40-04:00 Tiny refactor canEtaReduceToArity was only called internally, and always with two arguments equal to zero. This patch just specialises the function, and renames it to cantEtaReduceFun. No change in behaviour. - - - - - 56b403c9 by Ben Gamari at 2023-09-13T19:21:36-04:00 spec-constr: Lift argument limit for SPEC-marked functions When the user adds a SPEC argument to a function, they are informing us that they expect the function to be specialised. However, previously this instruction could be preempted by the specialised-argument limit (sc_max_args). Fix this. This fixes #14003. - - - - - 6840012e by Simon Peyton Jones at 2023-09-13T19:22:13-04:00 Fix eta reduction Issue #23922 showed that GHC was bogusly eta-reducing a join point. We should never eta-reduce (\x -> j x) to j, if j is a join point. It is extremly difficult to trigger this bug. It took me 45 mins of trying to make a small tests case, here immortalised as T23922a. - - - - - e5c00092 by Andreas Klebinger at 2023-09-14T08:57:43-04:00 Profiling: Properly escape characters when using `-pj`. There are some ways in which unusual characters like quotes or others can make it into cost centre names. So properly escape these. Fixes #23924 - - - - - ec490578 by Ellie Hermaszewska at 2023-09-14T08:58:24-04:00 Use clearer example variable names for bool eliminator - - - - - 5126a2fe by Sylvain Henry at 2023-09-15T11:18:02-04:00 Add missing int64/word64-to-double/float rules (#23907) CLC proposal: https://github.com/haskell/core-libraries-committee/issues/203 - - - - - 566ef411 by Mario Blažević at 2023-09-15T11:18:43-04:00 Fix and test TH pretty-printing of type operator role declarations This commit fixes and tests `Language.Haskell.TH.Ppr.pprint` so that it correctly pretty-prints `type role` declarations for operator names. Fixes #23954 - - - - - 8e05c54a by Simon Peyton Jones at 2023-09-16T01:42:33-04:00 Use correct FunTyFlag in adjustJoinPointType As the Lint error in #23952 showed, the function adjustJoinPointType was failing to adjust the FunTyFlag when adjusting the type. I don't think this caused the seg-fault reported in the ticket, but it is definitely. This patch fixes it. It is tricky to come up a small test case; Krzysztof came up with this one, but it only triggers a failure in GHC 9.6. - - - - - 778c84b6 by Pierre Le Marre at 2023-09-16T01:43:15-04:00 Update to Unicode 15.1.0 See: https://www.unicode.org/versions/Unicode15.1.0/ - - - - - f9d79a6c by Alan Zimmerman at 2023-09-18T00:00:14-04:00 EPA: track unicode version for unrestrictedFunTyCon Closes #23885 Updates haddock submodule - - - - - 9374f116 by Andrew Lelechenko at 2023-09-18T00:00:54-04:00 Bump parsec submodule to allow text-2.1 and bytestring-0.12 - - - - - 7ca0240e by Ben Gamari at 2023-09-18T15:16:48-04:00 base: Advertise linear time of readFloat As noted in #23538, `readFloat` has runtime that scales nonlinearly in the size of its input. Consequently, its use on untrusted input can be exploited as a denial-of-service vector. Point this out and suggest use of `read` instead. See #23538. - - - - - f3f58f13 by Simon Peyton Jones at 2023-09-18T15:17:24-04:00 Remove dead code GHC.CoreToStg.Prep.canFloat This function never fires, so we can delete it: #23965. - - - - - ccab5b15 by Ben Gamari at 2023-09-18T15:18:02-04:00 base/changelog: Move fix for #23907 to 9.8.1 section Since the fix was backported to 9.8.1 - - - - - 51b57d65 by Matthew Pickering at 2023-09-19T08:44:31-04:00 Add aarch64 alpine bindist This is dynamically linked and makes creating statically linked executables more straightforward. Fixes #23482 - - - - - 02c87213 by Matthew Pickering at 2023-09-19T08:44:31-04:00 Add aarch64-deb11 bindist This adds a debian 11 release job for aarch64. Fixes #22005 - - - - - 8b61dfd6 by Alexis King at 2023-09-19T08:45:13-04:00 Don’t store the async exception masking state in CATCH frames - - - - - 86d2971e by doyougnu at 2023-09-19T19:08:19-04:00 compiler,ghci: error codes link to HF error index closes: #23259 - adds -fprint-error-index-links={auto|always|never} flag - - - - - 5f826c18 by sheaf at 2023-09-19T19:09:03-04:00 Pass quantified tyvars in tcDefaultAssocDecl This commit passes the correct set of quantified type variables written by the user in associated type default declarations for validity checking. This ensures that validity checking of associated type defaults mirrors that of standalone type family instances. Fixes #23768 (see testcase T23734 in subsequent commit) - - - - - aba18424 by sheaf at 2023-09-19T19:09:03-04:00 Avoid panic in mkGADTVars This commit avoids panicking in mkGADTVars when we encounter a type variable as in #23784 that is bound by a user-written forall but not actually used. Fixes #23784 - - - - - a525a92a by sheaf at 2023-09-19T19:09:03-04:00 Adjust reporting of unused tyvars in data FamInsts This commit adjusts the validity checking of data family instances to improve the reporting of unused type variables. See Note [Out of scope tvs in data family instances] in GHC.Tc.Validity. The problem was that, in a situation such as data family D :: Type data instance forall (d :: Type). D = MkD the RHS passed to 'checkFamPatBinders' would be the TyCon app R:D d which mentions the type variable 'd' quantified in the user-written forall. Thus, when computing the set of unused type variables in the RHS of the data family instance, we would find that 'd' is used, and report a strange error message that would say that 'd' is not bound on the LHS. To fix this, we special-case the data-family instance case, manually extracting all the type variables that appear in the arguments of all the data constructores of the data family instance. Fixes #23778 - - - - - 28dd52ee by sheaf at 2023-09-19T19:09:03-04:00 Unused tyvars in FamInst: only report user tyvars This commit changes how we perform some validity checking for coercion axioms to mirror how we handle default declarations for associated type families. This allows us to keep track of whether type variables in type and data family instances were user-written or not, in order to only report the user-written ones in "unused type variable" error messages. Consider for example: {-# LANGUAGE PolyKinds #-} type family F type instance forall a. F = () In this case, we get two quantified type variables, (k :: Type) and (a :: k); the second being user-written, but the first is introduced by the typechecker. We should only report 'a' as being unused, as the user has no idea what 'k' is. Fixes #23734 - - - - - 1eed645c by sheaf at 2023-09-19T19:09:03-04:00 Validity: refactor treatment of data families This commit refactors the reporting of unused type variables in type and data family instances to be more principled. This avoids ad-hoc logic in the treatment of data family instances. - - - - - 35bc506b by John Ericson at 2023-09-19T19:09:40-04:00 Remove `ghc-cabal` It is dead code since the Make build system was removed. I tried to go over every match of `git grep -i ghc-cabal` to find other stray bits. Some of those might be workarounds that can be further removed. - - - - - 665ca116 by John Paul Adrian Glaubitz at 2023-09-19T19:10:39-04:00 Re-add unregisterised build support for sparc and sparc64 Closes #23959 - - - - - 142f8740 by Matthew Pickering at 2023-09-19T19:11:16-04:00 Bump ci-images to use updated version of Alex Fixes #23977 - - - - - fa977034 by John Ericson at 2023-09-21T12:55:25-04:00 Use Cabal 3.10 for Hadrian We need the newer version for `CABAL_FLAG_*` env vars for #17191. - - - - - a5d22cab by John Ericson at 2023-09-21T12:55:25-04:00 hadrian: `need` any `configure` script we will call When the script is changed, we should reconfigure. - - - - - db882b57 by John Ericson at 2023-09-21T12:55:25-04:00 hadrian: Make it easier to debug Cabal configure Right now, output is squashed. This make per-package configure scripts extremely hard to maintain, because we get vague "library is missing" errors when the actually probably is usually completely unrelated except for also involving the C/C++ toolchain. (I can always pass `-VVV` to Hadrian locally, but these errors are subtle and I often cannot reproduce them locally!) `--disable-option-checking` was added back in 75c6e0684dda585c37b4ac254cd7a13537a59a91 but seems to be a bit overkill; if other flags are passed that are not recognized behind the two from Cabal mentioned in the former comment, we *do* want to know about it. - - - - - 7ed65f5a by John Ericson at 2023-09-21T12:55:25-04:00 hadrian: Increase verbosity of certain cabal commands This is a hack to get around the cabal function we're calling *decreasing* the verbosity it passes to another function, which is the stuff we often actually care about. Sigh. Keeping this a separate commit so if this makes things too verbose it is easy to revert. - - - - - a4fde569 by John Ericson at 2023-09-21T12:55:25-04:00 rts: Move most external symbols logic to the configure script This is much more terse because we are programmatically handling the leading underscore. `findPtr` however is still handled in the Cabal file because we need a newer Cabal to pass flags to the configure script automatically. Co-Authored-By: Ben Gamari <ben at well-typed.com> - - - - - 56cc85fb by Andrew Lelechenko at 2023-09-21T12:56:21-04:00 Bump Cabal submodule to allow text-2.1 and bytestring-0.12 - - - - - 0cd6148c by Matthew Pickering at 2023-09-21T12:56:21-04:00 hadrian: Generate Distribution/Fields/Lexer.x before creating a source-dist - - - - - b10ba6a3 by Andrew Lelechenko at 2023-09-21T12:56:21-04:00 Bump hadrian's index-state to upgrade alex at least to 3.2.7.3 - - - - - 11ecc37b by Luite Stegeman at 2023-09-21T12:57:03-04:00 JS: correct file size and times Programs produced by the JavaScript backend were returning incorrect file sizes and modification times, causing cabal related tests to fail. This fixes the problem and adds an additional test that verifies basic file information operations. fixes #23980 - - - - - b35fd2cd by Ben Gamari at 2023-09-21T12:57:39-04:00 gitlab-ci: Drop libiserv from upload_ghc_libs libiserv has been merged into the ghci package. - - - - - 37ad04e8 by Ben Gamari at 2023-09-21T12:58:15-04:00 testsuite: Fix Windows line endings - - - - - 5795b365 by Ben Gamari at 2023-09-21T12:58:15-04:00 testsuite: Use makefile_test - - - - - 15118740 by Ben Gamari at 2023-09-21T12:58:55-04:00 system-cxx-std-lib: Add license and description - - - - - 0208f1d5 by Ben Gamari at 2023-09-21T12:59:33-04:00 gitlab/issue-templates: Rename bug.md -> default.md So that it is visible by default. - - - - - 23cc3f21 by Andrew Lelechenko at 2023-09-21T20:18:11+01:00 Bump submodule text to 2.1 - - - - - b8e4fe23 by Andrew Lelechenko at 2023-09-22T20:05:05-04:00 Bump submodule unix to 2.8.2.1 - - - - - 54b2016e by John Ericson at 2023-09-23T11:40:41-04:00 Move lib{numa,dw} defines to RTS configure Clean up the m4 to handle the auto case always and be more consistent. Also simplify the CPP --- we should always have both headers if we are using libnuma. "side effects" (AC_DEFINE, and AC_SUBST) are removed from the macros to better separate searching from actions taken based on search results. This might seem overkill now, but will make shuffling logic between configure scripts easier later. The macro comments are converted from `dnl` to `#` following the recomendation in https://www.gnu.org/software/autoconf/manual/autoconf-2.71/html_node/Macro-Definitions.html - - - - - d51b601b by John Ericson at 2023-09-23T11:40:50-04:00 Shuffle libzstd configuring between scripts Like the prior commit for libdw and libnuma, `AC_DEFINE` to RTS configure, `AC_SUBST` goes to the top-level configure script, and the documentation of the m4 macro is improved. - - - - - d1425af0 by John Ericson at 2023-09-23T11:41:03-04:00 Move `FP_ARM_OUTLINE_ATOMICS` to RTS configure It is just `AC_DEFINE` it belongs there instead. - - - - - 18de37e4 by John Ericson at 2023-09-23T11:41:03-04:00 Move mmap in the runtime linker check to the RTS configure `AC_DEFINE` should go there instead. - - - - - 74132c2b by Andrew Lelechenko at 2023-09-25T21:56:54-04:00 Elaborate comment on GHC_NO_UNICODE - - - - - de142aa2 by Ben Gamari at 2023-09-26T15:25:03-04:00 gitlab-ci: Mark T22012 as broken on CentOS 7 Due to #23979. - - - - - 6a896ce8 by Teo Camarasu at 2023-09-26T15:25:39-04:00 hadrian: better error for failing to find file's dependencies Resolves #24004 - - - - - d697a6c2 by Stefan Holdermans at 2023-09-26T20:58:37+00:00 Refactor uses of `partitionEithers . map` This patch changes occurences of the idiom `partitionEithers (map f xs)` by the simpler form `partitionWith f xs` where `partitionWith` is the utility function defined in `GHC.Utils.Misc`. Resolves: #23953 - - - - - 8a2968b7 by Stefan Holdermans at 2023-09-26T20:58:37+00:00 Refactor uses of `partitionEithers <$> mapM f xs` This patch changes occurences of the idiom `partitionEithers <$> mapM f xs` by the simpler form `partitionWithM f xs` where `partitionWithM` is a utility function newly added to `GHC.Utils.Misc`. - - - - - 6a27eb97 by Stefan Holdermans at 2023-09-26T20:58:37+00:00 Mark `GHC.Utils.Misc.partitionWithM` as inlineable This patch adds an `INLINEABLE` pragma for `partitionWithM` to ensure that the right-hand side of the definition of this function remains available for specialisation at call sites. - - - - - f1e5245a by David Binder at 2023-09-27T01:19:00-04:00 Add RTS option to supress tix file - - - - - 1f43124f by David Binder at 2023-09-27T01:19:00-04:00 Add expected output to testsuite in test interface-stability/base-exports - - - - - b9d2c354 by David Binder at 2023-09-27T01:19:00-04:00 Expose HpcFlags and getHpcFlags from GHC.RTS.Flags - - - - - 345675c6 by David Binder at 2023-09-27T01:19:00-04:00 Fix expected output of interface-stability test - - - - - 146e1c39 by David Binder at 2023-09-27T01:19:00-04:00 Implement getHpcFlags - - - - - 61ba8e20 by David Binder at 2023-09-27T01:19:00-04:00 Add section in user guide - - - - - ea05f890 by David Binder at 2023-09-27T01:19:01-04:00 Rename --emit-tix-file to --write-tix-file - - - - - cabce2ce by David Binder at 2023-09-27T01:19:01-04:00 Update the golden files for interface stability - - - - - 1dbdb9d0 by Krzysztof Gogolewski at 2023-09-27T01:19:37-04:00 Refactor: introduce stgArgRep The function 'stgArgType' returns the type in STG. But this violates the abstraction: in STG we're supposed to operate on PrimReps. This introduces stgArgRep ty = typePrimRep (stgArgType ty) stgArgRep1 ty = typePrimRep1 (stgArgType ty) stgArgRep_maybe ty = typePrimRep_maybe (stgArgType ty) stgArgType is still directly used for unboxed tuples (should be fixable), FFI and in ticky. - - - - - b02f8042 by Mario Blažević at 2023-09-27T17:33:28-04:00 Fix TH pretty-printer's parenthesization This PR Fixes `Language.Haskell.TH.Ppr.pprint` so it correctly emits parentheses where needed. Fixes #23962, #23968, #23971, and #23986 - - - - - 79104334 by Krzysztof Gogolewski at 2023-09-27T17:34:04-04:00 Add a testcase for #17564 The code in the ticket relied on the behaviour of Derived constraints. Derived constraints were removed in GHC 9.4 and now the code works as expected. - - - - - d7a80143 by sheaf at 2023-09-28T03:25:53-04:00 lint-codes: add new modes of operation This commit adds two new modes of operation to the lint-codes utility: list - list all statically used diagnostic codes outdated - list all outdated diagnostic codes The previous behaviour is now: test - test consistency and coverage of diagnostic codes - - - - - 477d223c by sheaf at 2023-09-28T03:25:53-04:00 lint codes: avoid using git-grep We manually traverse through the filesystem to find the diagnostic codes embedded in .stdout and .stderr files, to avoid any issues with old versions of grep. Fixes #23843 - - - - - a38ae69a by sheaf at 2023-09-28T03:25:53-04:00 lint-codes: add Hadrian targets This commit adds new Hadrian targets: codes, codes:used - list all used diagnostic codes codes:outdated - list outdated diagnostic codes This allows users to easily query GHC for used and outdated diagnostic codes, e.g. hadrian/build -j --flavour=<..> codes will list all used diagnostic codes in the command line by running the lint-codes utility in the "list codes" mode of operation. The diagnostic code consistency and coverage test is still run as usual, through the testsuite: hadrian/build test --only="codes" - - - - - 9cdd629b by Ben Gamari at 2023-09-28T03:26:29-04:00 hadrian: Install LICENSE files in bindists Fixes #23548. - - - - - b8ebf876 by Matthew Craven at 2023-09-28T03:27:05-04:00 Fix visibility when eta-reducing a type lambda Fixes #24014. - - - - - d3874407 by Torsten Schmits at 2023-09-30T16:08:10-04:00 Fix several mistakes around free variables in iface breakpoints Fixes #23612 , #23607, #23998 and #23666. MR: !11026 The fingerprinting logic in `Iface.Recomp` failed lookups when processing decls containing breakpoints for two reasons: * IfaceBreakpoint created binders for free variables instead of expressions * When collecting free names for the dependency analysis for fingerprinting, breakpoint FVs were skipped - - - - - ef5342cd by Simon Peyton Jones at 2023-09-30T16:08:48-04:00 Refactor to combine HsLam and HsLamCase This MR is pure refactoring (#23916): * Combine `HsLam` and `HsLamCase` * Combine `HsCmdLam` and `HsCmdLamCase` This just arranges to treat uniformly \x -> e \case pi -> ei \cases pis -> ie In the exising code base the first is treated differently to the latter two. No change in behaviour. More specifics: * Combine `HsLam` and `HsLamCase` (constructors of `Language.Haskell.Syntax.Expr.HsExpr`) into one data construtor covering * Lambda * `\case` * `\cases` * The new `HsLam` has an argument of type `HsLamVariant` to distinguish the three cases. * Similarly, combine `HsCmdLam` and `HsCmdLamCase` (constructors of `Language.Haskell.Syntax.Expr.HsCmd` ) into one. * Similarly, combine `mkHsLamPV` and `mkHsLamCasePV` (methods of class `DisambECP`) into one. (Thank you Alan Zimmerman.) * Similarly, combine `LambdaExpr` and `LamCaseAlt` (constructors of `Language.Haskell.Syntax.Expr.HsMatchContext`) into one: `LamAlt` with a `HsLamVariant` argument. * Similarly, combine `KappaExpr` and `ArrowLamCaseAlt` (constructors of `Language.Haskell.Syntax.Expr.HsArrowMatchContext`) into one: `ArrowLamAlt` with a `HsLamVariant` argument. * Similarly, combine `PsErrLambdaInPat` and `PsErrLambdaCaseInPat` (constructors of `GHC.Parser.Errors.Ppr.PsError`) into one. * Similarly, combine `PsErrLambdaInPat` and `PsErrLambdaCaseInPat` (constructors of `GHC.Parser.Errors.Ppr.PsError`) into one. * In the same `PsError` data type, combine `PsErrLambdaCmdInFunAppCmd` and `PsErrLambdaCaseCmdInFunAppCmd` into one. * In the same `PsError` data tpye, combine `PsErrLambdaInFunAppExpr` and `PsErrLambdaCaseInFunAppExpr` into one. p* Smilarly combine `ExpectedFunTyLam` and `ExpectedFunTyLamCase` (constructors of `GHC.Tc.Types.Origin.ExpectedFunTyOrigin`) into one. Phew! - - - - - b048bea0 by Andreas Klebinger at 2023-09-30T16:09:24-04:00 Arm: Make ppr methods easier to use by not requiring NCGConfig - - - - - 2adc0508 by Andreas Klebinger at 2023-09-30T16:09:24-04:00 AArch64: Fix broken conditional jumps for offsets >= 1MB Rewrite conditional jump instructions with offsets >= 1MB to use unconditional jumps to avoid overflowing the immediate. Fixes #23746 - - - - - 1424f790 by Alan Zimmerman at 2023-09-30T16:10:00-04:00 EPA: Replace Monoid with NoAnn We currently use the Monoid class as a constraint on Exact Print Annotation functions, so we can use mempty. But this leads to requiring Semigroup instances too, which do not always make sense. Instead, introduce a class NoAnn, with a function noAnn analogous to mempty. Closes #20372 Updates haddock submodule - - - - - c1a3ecde by Ben Gamari at 2023-09-30T16:10:36-04:00 users-guide: Refactor handling of :base-ref: et al. - - - - - bc204783 by Richard Eisenberg at 2023-10-02T14:50:52+02:00 Simplify and correct nasty case in coercion opt This fixes #21062. No test case, because triggering this code seems challenging. - - - - - 9c9ca67e by Andrew Lelechenko at 2023-10-04T05:42:28-04:00 Bump bytestring submodule to 0.12.0.2 - - - - - 4e46dc2b by Andrew Lelechenko at 2023-10-04T05:42:28-04:00 Inline bucket_match - - - - - f6b2751f by Ben Gamari at 2023-10-04T05:43:05-04:00 configure: Fix #21712 again This is a bit of a shot in the dark to fix #24033, which appears to be another instance of #21712. For some reason the ld-override logic *still* appears to be active on Darwin targets (or at least one). Consequently, on misconfigured systems we may choose a non-`ld64` linker. It's a bit unclear exactly what happened in #24033 but ultimately the check added for #21712 was not quite right, checking for the `ghc_host_os` (the value of which depends upon the bootstrap compiler) instead of the target platform. Fix this. Fixes #24033. - - - - - 2f0a101d by Krzysztof Gogolewski at 2023-10-04T05:43:42-04:00 Add a regression test for #24029 - - - - - 8cee3fd7 by sheaf at 2023-10-04T05:44:22-04:00 Fix non-symbolic children lookup of fixity decl The fix for #23664 did not correctly account for non-symbolic names when looking up children of a given parent. This one-line fix changes that. Fixes #24037 - - - - - a4785b33 by Cheng Shao at 2023-10-04T05:44:59-04:00 rts: fix incorrect ticket reference - - - - - e037f459 by Ben Gamari at 2023-10-04T05:45:35-04:00 users-guide: Fix discussion of -Wpartial-fields * fix a few typos * add a new example showing when the warning fires * clarify the existing example * point out -Wincomplete-record-selects Fixes #24049. - - - - - 8ff3134e by Matthew Pickering at 2023-10-05T05:34:58-04:00 Revert "Pass preprocessor options to C compiler when building foreign C files (#16737)" This reverts commit 1c18d3b41f897f34a93669edaebe6069f319f9e2. `-optP` should pass options to the preprocessor, that might be a very different program to the C compiler, so passing the options to the C compiler is likely to result in `-optP` being useless. Fixes #17185 and #21291 - - - - - 8f6010b9 by Ben Gamari at 2023-10-05T05:35:36-04:00 rts/nonmoving: Fix on LLP64 platforms Previously `NONMOVING_SEGMENT_MASK` and friends were defined with the `UL` size suffix. However, this is wrong on LLP64 platforms like Windows, where `long` is 32-bits. Fixes #23003. Fixes #24042. - - - - - f20d02f8 by Andreas Klebinger at 2023-10-05T05:36:14-04:00 Fix isAArch64Bitmask for 32bit immediates. Fixes #23802 - - - - - 63afb701 by Bryan Richter at 2023-10-05T05:36:49-04:00 Work around perf note fetch failure Addresses #24055. - - - - - 242102f4 by Krzysztof Gogolewski at 2023-10-05T05:37:26-04:00 Add a test for #21348 - - - - - 7d390bce by Rewbert at 2023-10-05T05:38:08-04:00 Fixes #24046 - - - - - 69abb171 by Finley McIlwaine at 2023-10-06T14:06:28-07:00 Ensure unconstrained instance dictionaries get IPE info In the `StgRhsCon` case of `GHC.Stg.Debug.collectStgRhs`, we were not coming up with an initial source span based on the span of the binder, which was causing instance dictionaries without dynamic superclass constraints to not have source locations in their IPE info. Now they do. Resolves #24005 - - - - - 390443b7 by Andreas Klebinger at 2023-10-07T10:00:20-04:00 rts: Split up rts/include/stg/MachRegs.h by arch - - - - - 3685942f by Bryan Richter at 2023-10-07T10:00:56-04:00 Actually set hackage index state Or at least, use a version of the cabal command that *claims* to set the index state. Time will tell. - - - - - 46a0e5be by Bryan Richter at 2023-10-07T10:00:56-04:00 Update hackage index state - - - - - d4b037de by Bryan Richter at 2023-10-07T10:00:56-04:00 Ensure hadrian uses CI's hackage index state - - - - - e206be64 by Andrew Lelechenko at 2023-10-08T15:06:14-04:00 Do not use O_NONBLOCK on regular files or block devices CLC proposal https://github.com/haskell/core-libraries-committee/issues/166 - - - - - a06197c4 by David Binder at 2023-10-08T15:06:55-04:00 Update hpc-bin submodule to 0.69 - - - - - ed6785b6 by David Binder at 2023-10-08T15:06:55-04:00 Update Hadrian with correct path to happy file for hpc-bin - - - - - 94066d58 by Alan Zimmerman at 2023-10-09T21:35:53-04:00 EPA: Introduce HasAnnotation class The class is defined as class HasAnnotation e where noAnnSrcSpan :: SrcSpan -> e This generalises noAnnSrcSpan, and allows noLocA :: (HasAnnotation e) => a -> GenLocated e a noLocA = L (noAnnSrcSpan noSrcSpan) - - - - - 8792a1bc by Ben Gamari at 2023-10-09T21:36:29-04:00 Bump unix submodule to v2.8.3.0 - - - - - e96c51cb by Andreas Klebinger at 2023-10-10T16:44:27+01:00 Add a flag -fkeep-auto-rules to optionally keep auto-generated rules around. The motivation for the flag is given in #21917. - - - - - 3ed58cef by Matthew Pickering at 2023-10-10T19:01:22-04:00 hadrian: Add ghcToolchain to tool args list This allows you to load ghc-toolchain and ghc-toolchain-bin into HLS. - - - - - 476c02d4 by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Normalise triple via config.sub We were not normalising the target triple anymore like we did with the old make build system. Fixes #23856 - - - - - 303dd237 by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Add missing vendor normalisation This is copied from m4/ghc_convert_vendor.m4 Towards #23868 - - - - - 838026c9 by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Add loongarch64 to parseArch Towards #23868 - - - - - 1a5bc0b5 by Matthew Pickering at 2023-10-10T19:01:22-04:00 Add same LD hack to ghc-toolchain In the ./configure script, if you pass the `LD` variable then this has the effect of stopping use searching for a linker and hence passing `-fuse-ld=...`. We want to emulate this logic in ghc-toolchain, if a use explicilty specifies `LD` variable then don't add `-fuse-ld=..` with the goal of making ./configure and ghc-toolchain agree on which flags to use when using the C compiler as a linker. This is quite unsavoury as we don't bake the choice of LD into the configuration anywhere but what's important for now is making ghc-toolchain and ./configure agree as much as possible. See #23857 for more discussion - - - - - 42d50b5a by Ben Gamari at 2023-10-10T19:01:22-04:00 ghc-toolchain: Check for C99 support with -std=c99 Previously we failed to try enabling C99 support with `-std=c99`, as `autoconf` attempts. This broke on older compilers (e.g. CentOS 7) which don't enable C99 by default. Fixes #23879. - - - - - da2961af by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Add endianess check using __BYTE_ORDER__ macro In very old toolchains the BYTE_ORDER macro is not set but thankfully the __BYTE_ORDER__ macro can be used instead. - - - - - d8da73cd by Matthew Pickering at 2023-10-10T19:01:22-04:00 configure: AC_PATH_TARGET_TOOL for LD We want to make sure that LD is set to an absolute path in order to be consistent with the `LD=$(command -v ld)` call. The AC_PATH_TARGET_TOOL macro uses the absolute path rather than AC_CHECK_TARGET_TOOL which might use a relative path. - - - - - 171f93cc by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Check whether we need -std=gnu99 for CPP as well In ./configure the C99 flag is passed to the C compiler when used as a C preprocessor. So we also check the same thing in ghc-toolchain. - - - - - 89a0918d by Matthew Pickering at 2023-10-10T19:01:22-04:00 Check for --target linker flag separately to C compiler There are situations where the C compiler doesn't accept `--target` but when used as a linker it does (but doesn't do anything most likely) In particular with old gcc toolchains, the C compiler doesn't support --target but when used as a linker it does. - - - - - 37218329 by Matthew Pickering at 2023-10-10T19:01:22-04:00 Use Cc to compile test file in nopie check We were attempting to use the C compiler, as a linker, to compile a file in the nopie check, but that won't work in general as the flags we pass to the linker might not be compatible with the ones we pass when using the C compiler. - - - - - 9b2dfd21 by Matthew Pickering at 2023-10-10T19:01:22-04:00 configure: Error when ghc-toolchain fails to compile This is a small QOL change as if you are working on ghc-toolchain and it fails to compile then configure will continue and can give you outdated results. - - - - - 1f0de49a by Matthew Pickering at 2023-10-10T19:01:22-04:00 configure: Check whether -no-pie works when the C compiler is used as a linker `-no-pie` is a flag we pass when using the C compiler as a linker (see pieCCLDOpts in GHC.Driver.Session) so we should test whether the C compiler used as a linker supports the flag, rather than just the C compiler. - - - - - 62cd2579 by Matthew Pickering at 2023-10-10T19:01:22-04:00 ghc-toolchain: Remove javascript special case for --target detection emcc when used as a linker seems to ignore the --target flag, and for consistency with configure which now tests for --target, we remove this special case. - - - - - 0720fde7 by Ben Gamari at 2023-10-10T19:01:22-04:00 toolchain: Don't pass --target to emscripten toolchain As noted in `Note [Don't pass --target to emscripten toolchain]`, emscripten's `emcc` is rather inconsistent with respect to its treatment of the `--target` flag. Avoid this by special-casing this toolchain in the `configure` script and `ghc-toolchain`. Fixes on aspect of #23744. - - - - - 6354e1da by Matthew Pickering at 2023-10-10T19:01:22-04:00 hadrian: Don't pass `--gcc-options` as a --configure-arg to cabal configure Stop passing -gcc-options which mixed together linker flags and non-linker flags. There's no guarantee the C compiler will accept both of these in each mode. - - - - - c00a4bd6 by Ben Gamari at 2023-10-10T19:01:22-04:00 configure: Probe stage0 link flags For consistency with later stages and CC. - - - - - 1f11e7c4 by Sebastian Graf at 2023-10-10T19:01:58-04:00 Stricter Binary.get in GHC.Types.Unit (#23964) I noticed some thunking while looking at Core. This change has very modest, but throughout positive ghc/alloc effect: ``` hard_hole_fits(normal) ghc/alloc 283,057,664 281,620,872 -0.5% geo. mean -0.1% minimum -0.5% maximum +0.0% ``` Fixes #23964. - - - - - a4f1a181 by Bryan Richter at 2023-10-10T19:02:37-04:00 rel_eng/upload.sh cleanups - - - - - 80705335 by doyougnu at 2023-10-10T19:03:18-04:00 ci: add javascript label rule This adds a rule which triggers the javascript job when the "javascript" label is assigned to an MR. - - - - - a2c0fff6 by Matthew Craven at 2023-10-10T19:03:54-04:00 Make 'wWarningFlagsDeps' include every WarningFlag Fixes #24071. - - - - - d055f099 by Jan Hrček at 2023-10-10T19:04:33-04:00 Fix pretty printing of overlap pragmas in TH splices (fixes #24074) - - - - - 0746b868 by Andreas Klebinger at 2023-10-10T19:05:09-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - 739f4e6f by Andreas Klebinger at 2023-10-10T19:05:09-04:00 AArch NCG: Refactor getRegister' Remove some special cases which can be handled just as well by the generic case. This increases code re-use while also fixing #23749. Since some of the special case wasn't upholding Note [Signed arithmetic on AArch64]. - - - - - 1b213d33 by Andreas Klebinger at 2023-10-10T19:05:09-04:00 Aarch ncg: Optimize immediate use for address calculations When the offset doesn't fit into the immediate we now just reuse the general getRegister' code path which is well optimized to compute the offset into a register instead of a special case for CmmRegOff. This means we generate a lot less code under certain conditions which is why performance metrics for these improve. ------------------------- Metric Decrease: T4801 T5321FD T5321Fun ------------------------- - - - - - b7df0732 by John Ericson at 2023-10-11T16:02:11-04:00 RTS configure: Move over mem management checks These are for heap allocation, a strictly RTS concern. All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. The RTS configure one has a new ``` AC_CHECK_SIZEOF([void *]) ``` that the top-level configure version didn't have, so that `ac_cv_sizeof_void_p` is defined. Once more code is moved over in latter commits, that can go away. Progress towards #17191 - - - - - 41130a65 by John Ericson at 2023-10-11T16:02:11-04:00 RTS configure: Move over `__thread` check This used by (@bgamari thinks) the `GCThread` abstraction in the RTS. All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. Progress towards #17191 - - - - - cc5ec2bd by John Ericson at 2023-10-11T16:02:11-04:00 RTS configure: Move over misc function checks These are for general use in the RTS. All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. Progress towards #17191 - - - - - 809e7c2d by John Ericson at 2023-10-11T16:02:11-04:00 RTS configure: Move over `eventfd` check This check is for the RTS part of the event manager and has a corresponding part in `base`. All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. Progress towards #17191 - - - - - 58f3babf by John Ericson at 2023-10-11T16:02:48-04:00 Split `FP_CHECK_PTHREADS` and move part to RTS configure `NEED_PTHREAD_LIB` is unused since 3609340743c1b25fdfd0e18b1670dac54c8d8623 (part of the make build system), and so is no longer defined. Progress towards #17191 - - - - - e99cf237 by Moritz Angermann at 2023-10-11T16:03:24-04:00 nativeGen: section flags for .text$foo only Commit 3ece9856d157c85511d59f9f862ab351bbd9b38b, was supposed to fix #22834 in !9810. It does however add "xr" indiscriminatly to .text sections even if splitSections is disabled. This leads to the assembler saying: ghc_1.s:7849:0: error: Warning: Ignoring changed section attributes for .text | 7849 | .section .text,"xr" | ^ - - - - - f383a242 by Sylvain Henry at 2023-10-11T16:04:04-04:00 Modularity: pass TempDir instead of DynFlags (#17957) - - - - - 34fc28b0 by John Ericson at 2023-10-12T06:48:28-04:00 Test that functions from `mingwex` are available Ryan wrote these two minimizations, but they never got added to the test suite. See #23309, #23378 Co-Authored-By: Ben Gamari <bgamari.foss at gmail.com> Co-Authored-By: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - bdb54a0e by John Ericson at 2023-10-12T06:48:28-04:00 Do not check for the `mingwex` library in `/configure` See the recent discussion in !10360 --- Cabal will itself check for the library for the packages that need it, and while the autoconf check additionally does some other things like define a `HAS_LIBMINGWEX` C Preprocessor macro, those other things are also unused and unneeded. Progress towards #17191, which aims to get rid of `/configure` entirely. - - - - - 43e814e1 by Ben Gamari at 2023-10-12T06:49:40-04:00 base: Introduce move modules into src The only non-move changes here are whitespace changes to pass the `whitespace` test and a few testsuite adaptations. - - - - - df81536f by Moritz Angermann at 2023-10-12T06:50:16-04:00 [PEi386 linker] Bounds check and null-deref guard We should resonably be able to expect that we won't exceed the number of sections if we assume to be dealing with legal object files. We can however not guarantee that we get some negative values, and while we try to special case most, we should exclude negative indexing into the sections array. We also need to ensure that we do not try to derefences targetSection, if it is NULL, due to the switch statement. - - - - - c74c4f00 by John Ericson at 2023-10-12T10:31:13-04:00 Move apple compat check to RTS configure - - - - - c80778ea by John Ericson at 2023-10-12T10:31:13-04:00 Move clock/timer fun checks to RTS configure Actual library check (which will set the Cabal flag) is left in the top-level configure for now. Progress towards #17191 - - - - - 7f9f2686 by John Ericson at 2023-10-12T10:31:13-04:00 Move visibility and "musttail" annotation checks to the RTS configure All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. Progress towards #17191 - - - - - ffb3efe6 by John Ericson at 2023-10-12T10:31:13-04:00 Move leading underscore checks to RTS configure `CabalLeadingUnderscore` is done via Hadrian already, so we can stop `AC_SUBST`ing it completely. - - - - - 25fa4b02 by John Ericson at 2023-10-12T10:31:13-04:00 Move alloca, fork, const, and big endian checks to RTS configure All of this should boil down to `AC_DEFINE` not `AC_SUBST`, so it belongs in the RTS configure and should be safe to move without modification. - - - - - 5170f42a by John Ericson at 2023-10-12T10:31:13-04:00 Move libdl check to RTS configure - - - - - ea7a1447 by John Ericson at 2023-10-12T10:31:13-04:00 Adjust `FP_FIND_LIBFFI` Just set vars, and `AC_SUBST` in top-level configure. Don't define `HAVE_SYSTEM_LIBFFI` because nothing is using it. It hasn't be in used since 3609340743c1b25fdfd0e18b1670dac54c8d8623 (part of the make build system). - - - - - f399812c by John Ericson at 2023-10-12T10:31:13-04:00 Split BFD support to RTS configure The flag is still in the top-level configure, but the other checks (which define various macros --- important) are in the RTS configure. - - - - - f64f44e9 by John Ericson at 2023-10-12T10:31:13-04:00 Split libm check between top level and RTS - - - - - dafc4709 by Moritz Angermann at 2023-10-12T10:31:49-04:00 CgUtils.fixStgRegStmt respect register width This change ensure that the reg + offset computation is always of the same size. Before this we could end up with a 64bit register, and then add a 32bit offset (on 32bit platforms). This not only would fail type sanity checking, but also incorrectly truncate 64bit values into 32bit values silently on 32bit architectures. - - - - - 9e6ef7ba by Matthew Pickering at 2023-10-12T20:35:00-04:00 hadrian: Decrease verbosity of cabal commands In Normal, most tools do not produce output to stdout unless there are error conditions. Reverts 7ed65f5a1bc8e040e318ccff395f53a9bbfd8217 - - - - - 08fc27af by John Ericson at 2023-10-12T20:35:36-04:00 Do not substitute `@...@` for stage-specific values in cabal files `rts` and `ghc-prim` now no longer have a `*.cabal.in` to set Cabal flag defaults; instead manual choices are passed to configure in the usual way. The old way was fundamentally broken, because it meant we were baking these Cabal files for a specific stage. Now we only do stage-agnostic @...@ substitution in cabal files (the GHC version), and so all stage-specific configuration is properly confined to `_build` and the right stage dir. Also `include-ghc-prim` is a flag that no longer exists for `ghc-prim` (it was removed in 835d8ddbbfb11796ea8a03d1806b7cee38ba17a6) so I got rid of it. Co-Authored-By: Matthew Pickering <matthewtpickering at gmail.com> - - - - - a0ac8785 by Sebastian Graf at 2023-10-14T19:17:12-04:00 Fix restarts in .ghcid Using the whole of `hadrian/` restarted in a loop for me. - - - - - fea9ecdb by Sebastian Graf at 2023-10-14T19:17:12-04:00 CorePrep: Refactor FloatingBind (#23442) A drastically improved architecture for local floating in CorePrep that decouples the decision of whether a float is going to be let- or case-bound from how far it can float (out of strict contexts, out of lazy contexts, to top-level). There are a couple of new Notes describing the effort: * `Note [Floating in CorePrep]` for the overview * `Note [BindInfo and FloatInfo]` for the new classification of floats * `Note [Floats and FloatDecision]` for how FloatInfo is used to inform floating decisions This is necessary ground work for proper treatment of Strict fields and unlifted values at top-level. Fixes #23442. NoFib results (omitted = 0.0%): ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- pretty 0.0% -1.6% scc 0.0% -1.7% -------------------------------------------------------------------------------- Min 0.0% -1.7% Max 0.0% -0.0% Geometric Mean -0.0% -0.0% ``` - - - - - 32523713 by Matthew Pickering at 2023-10-14T19:17:49-04:00 hadrian: Move ghcBinDeps into ghcLibDeps This completes a5227080b57cb51ac34d4c9de1accdf6360b818b, the `ghc-usage.txt` and `ghci-usage.txt` file are also used by the `ghc` library so need to make sure they are present in the libdir even if we are not going to build `ghc-bin`. This also fixes things for cross compilers because the stage2 cross-compiler requires the ghc-usage.txt file, but we are using the stage2 lib folder but not building stage3:exe:ghc-bin so ghc-usage.txt was not being generated. - - - - - ec3c4488 by sheaf at 2023-10-14T19:18:29-04:00 Combine GREs when combining in mkImportOccEnv In `GHC.Rename.Names.mkImportOccEnv`, we sometimes discard one import item in favour of another, as explained in Note [Dealing with imports] in `GHC.Rename.Names`. However, this can cause us to lose track of important parent information. Consider for example #24084: module M1 where { class C a where { type T a } } module M2 ( module M1 ) where { import M1 } module M3 where { import M2 ( C, T ); instance C () where T () = () } When processing the import list of `M3`, we start off (for reasons that are not relevant right now) with two `Avail`s attached to `T`, namely `C(C, T)` and `T(T)`. We combine them in the `combine` function of `mkImportOccEnv`; as described in Note [Dealing with imports] we discard `C(C, T)` in favour of `T(T)`. However, in doing so, we **must not** discard the information want that `C` is the parent of `T`. Indeed, losing track of this information can cause errors when importing, as we could get an error of the form ‘T’ is not a (visible) associated type of class ‘C’ We fix this by combining the two GREs for `T` using `plusGRE`. Fixes #24084 - - - - - 257c2807 by Ilias Tsitsimpis at 2023-10-14T19:19:07-04:00 hadrian: Pass -DNOSMP to C compiler when needed Hadrian passes the -DNOSMP flag to GHC when the target doesn't support SMP, but doesn't pass it to CC as well, leading to the following compilation error on mips64el: | Run Cc (FindCDependencies CDep) Stage1: rts/sm/NonMovingScav.c => _build/stage1/rts/build/c/sm/NonMovingScav.o.d Command line: /usr/bin/mips64el-linux-gnuabi64-gcc -E -MM -MG -MF _build/stage1/rts/build/c/hooks/FlagDefaults.thr_debug_p_o.d -MT _build/stage1/rts/build/c/hooks/FlagDefaults.o -Irts/include -I_build/stage1/rts/build -I_build/stage1/rts/build/include -Irts/include -x c rts/hooks/FlagDefaults.c -Wall -Wextra -Wstrict-prototypes -Wmissing-prototypes -Wmissing-declarations -Winline -Wpointer-arith -Wmissing-noreturn -Wnested-externs -Wredundant-decls -Wundef -fno-strict-aliasing -DTHREADED_RTS -DDEBUG -fomit-frame-pointer -O2 -g -Irts -I_build/stage1/rts/build -DDEBUG -fno-omit-frame-pointer -g3 -O0 ===> Command failed with error code: 1 In file included from rts/include/Stg.h:348, from rts/include/Rts.h:38, from rts/hooks/FlagDefaults.c:8: rts/include/stg/SMP.h:416:2: error: #error memory barriers unimplemented on this architecture 416 | #error memory barriers unimplemented on this architecture | ^~~~~ rts/include/stg/SMP.h:440:2: error: #error memory barriers unimplemented on this architecture 440 | #error memory barriers unimplemented on this architecture | ^~~~~ rts/include/stg/SMP.h:464:2: error: #error memory barriers unimplemented on this architecture 464 | #error memory barriers unimplemented on this architecture | ^~~~~ The old make system correctly passed this flag to both GHC and CC [1]. Fix this error by passing -DNOSMP to CC as well. [1] https://gitlab.haskell.org/ghc/ghc/-/blob/00920f176b0235d5bb52a8e054d89a664f8938fe/rts/ghc.mk#L407 Closes #24082 - - - - - 13d3c613 by John Ericson at 2023-10-14T19:19:42-04:00 Users Guide: Drop dead code for Haddock refs to `parallel` I noticed while working on !11451 that `@LIBRARY_parallel_UNIT_ID@` was not substituted. It is dead code -- there is no `parallel-ref` usages and it doesn't look like there ever was (going back to 3e5d0f188d6c8633e55e9ba6c8941c07e459fa4b), so let's delete it. - - - - - fe067577 by Sylvain Henry at 2023-10-18T19:40:25-04:00 Avoid out-of-bound array access in bigNatIsPowerOf2 (fix #24066) bigNatIndex# in the `where` clause wasn't guarded by "bigNatIsZero a". - - - - - cc1625b1 by Sylvain Henry at 2023-10-18T19:40:25-04:00 Bignum: fix right shift of negative BigNat with native backend - - - - - cbe4400d by Sylvain Henry at 2023-10-18T19:40:25-04:00 Rts: expose rtsOutOfBoundsAccess symbol - - - - - 72c7380c by Sylvain Henry at 2023-10-18T19:40:25-04:00 Hadrian: enable `-fcheck-prim-bounds` in validate flavour This allows T24066 to fail when the bug is present. Otherwise the out-of-bound access isn't detected as it happens in ghc-bignum which wasn't compiled with the bounds check. - - - - - f9436990 by John Ericson at 2023-10-18T19:41:01-04:00 Make Hadrian solely responsible for substituting `docs/users_guide/ghc_config.py.in` Fixes #24091 Progress on #23966 Issue #24091 reports that `@ProjectVersion@` is no longer being substituted in the GHC user's guide. I assume this is a recent issue, but I am not sure how it's worked since c1a3ecde720b3bddc2c8616daaa06ee324e602ab; it looks like both Hadrian and configure are trying to substitute the same `.in` file! Now only Hadrian does. That is better anyways; already something that issue #23966 requested. It seems like we were missing some dependencies in Hadrian. (I really, really hate that this is possible!) Hopefully it is fixed now. - - - - - b12df0bb by John Ericson at 2023-10-18T19:41:37-04:00 `ghcversion.h`: No need to cope with undefined `ProjectPatchLevel*` Since 4e6c80197f1cc46dfdef0300de46847c7cfbdcb0, these are guaranteed to be defined. (Guaranteed including a test in the testsuite.) - - - - - 0295375a by John Ericson at 2023-10-18T19:41:37-04:00 Generate `ghcversion.h` from a `.in` file Now that there are no conditional sections (see the previous commit), we can just a do simple substitution rather than pasting it together line by line. Progress on #23966 - - - - - 740a1b85 by Krzysztof Gogolewski at 2023-10-19T11:37:20-04:00 Add a regression test for #24064 - - - - - 921fbf2f by Hécate Moonlight at 2023-10-19T11:37:59-04:00 CLC Proposal #182: Export List from Data.List Proposal link: https://github.com/haskell/core-libraries-committee/issues/182 - - - - - 4f02d3c1 by Sylvain Henry at 2023-10-20T04:01:32-04:00 rts: fix small argument passing on big-endian arch (fix #23387) - - - - - b86243b4 by Sylvain Henry at 2023-10-20T04:02:13-04:00 Interpreter: fix literal alignment on big-endian architectures (fix #19261) Literals weren't correctly aligned on big-endian, despite what the comment said. - - - - - a4b2ec47 by Sylvain Henry at 2023-10-20T04:02:54-04:00 Testsuite: recomp011 and recomp015 are fixed on powerpc These tests have been fixed but not tested and re-enabled on big-endian powerpc (see comments in #11260 and #11323) - - - - - fded7dd4 by Sebastian Graf at 2023-10-20T04:03:30-04:00 CorePrep: Allow floating dictionary applications in -O0 into a Rec (#24102) - - - - - 02efc181 by John Ericson at 2023-10-22T02:48:55-04:00 Move function checks to RTS configure Some of these functions are used in `base` too, but we can copy the checks over to its configure if that's an issue. - - - - - 5f4bccab by John Ericson at 2023-10-22T02:48:55-04:00 Move over a number of C-style checks to RTS configure - - - - - 5cf04f58 by John Ericson at 2023-10-22T02:48:55-04:00 Move/Copy more `AC_DEFINE` to RTS config Only exception is the LLVM version macros, which are used for GHC itself. - - - - - b8ce5dfe by John Ericson at 2023-10-22T02:48:55-04:00 Define `TABLES_NEXT_TO_CODE` in the RTS configure We create a new cabal flag to facilitate this. - - - - - 4a40271e by John Ericson at 2023-10-22T02:48:55-04:00 Configure scripts: `checkOS`: Make a bit more robust `mingw64` and `mingw32` are now both accepted for `OSMinGW32`. This allows us to cope with configs/triples that we haven't normalized extra being what GNU `config.sub` does. - - - - - 16bec0a0 by John Ericson at 2023-10-22T02:48:55-04:00 Generate `ghcplatform.h` from RTS configure We create a new cabal flag to facilitate this. - - - - - 7dfcab2f by John Ericson at 2023-10-22T02:48:55-04:00 Get rid of all mention of `mk/config.h` The RTS configure script is now solely responsible for managing its headers; the top level configure script does not help. - - - - - c1e3719c by Cheng Shao at 2023-10-22T02:49:33-04:00 rts: drop stale mentions of MIN_UPD_SIZE We used to have MIN_UPD_SIZE macro that describes the minimum reserved size for thunks, so that the thunk can be overwritten in place as indirections or blackholes. However, this macro has not been actually defined or used anywhere since a long time ago; StgThunkHeader already reserves a padding word for this purpose. Hence this patch which drops stale mentions of MIN_UPD_SIZE. - - - - - d24b0d85 by Andrew Lelechenko at 2023-10-22T02:50:11-04:00 base changelog: move non-backported entries from 4.19 section to 4.20 Neither !10933 (check https://hackage.haskell.org/package/base-4.19.0.0/docs/src/Text.Read.Lex.html#numberToRangedRational) nor !10189 (check https://hackage.haskell.org/package/base-4.19.0.0/docs/src/Data.List.NonEmpty.html#unzip) were backported to `base-4.19.0.0`. Moving them to `base-4.20.0.0` section. Also minor stylistic changes to other entries, bringing them to a uniform form. - - - - - de78b32a by Alan Zimmerman at 2023-10-23T09:09:41-04:00 EPA Some tweaks to annotations - Fix span for GRHS - Move TrailingAnns from last match to FunBind - Fix GADT 'where' clause span - Capture full range for a CaseAlt Match - - - - - d5a8780d by Simon Hengel at 2023-10-23T09:10:23-04:00 Update primitives.rst - - - - - 4d075924 by Josh Meredith at 2023-10-24T23:04:12+11:00 JS/userguide: add explanation of writing jsbits - - - - - 07ab5cc1 by Cheng Shao at 2023-10-24T15:40:32-04:00 testsuite: increase timeout of ghc-api tests for wasm32 ghc-api tests for wasm32 are more likely to timeout due to the large wasm module sizes, especially when testing with wasm native tail calls, given wasmtime's handling of tail call opcodes are suboptimal at the moment. It makes sense to increase timeout specifically for these tests on wasm32. This doesn't affect other targets, and for wasm32 we don't increase timeout for all tests, so not to risk letting major performance regressions slip through the testsuite. - - - - - 0d6acca5 by Greg Steuck at 2023-10-26T08:44:23-04:00 Explicitly require RLIMIT_AS before use in OSMem.c This is done elsewhere in the source tree. It also suddenly is required on OpenBSD. - - - - - 9408b086 by Sylvain Henry at 2023-10-26T08:45:03-04:00 Modularity: modularize external linker Decouple runLink from DynFlags to allow calling runLink more easily. This is preliminary work for calling Emscripten's linker (emcc) from our JavaScript linker. - - - - - e0f35030 by doyougnu at 2023-10-27T08:41:12-04:00 js: add JStg IR, remove unsaturated constructor - Major step towards #22736 and adding the optimizer in #22261 - - - - - 35587eba by Simon Peyton Jones at 2023-10-27T08:41:48-04:00 Fix a bug in tail calls with ticks See #24078 for the diagnosis. The change affects only the Tick case of occurrence analysis. It's a bit hard to test, so no regression test (yet anyway). - - - - - 9bc5cb92 by Matthew Craven at 2023-10-28T07:06:17-04:00 Teach tag-inference about SeqOp/seq# Fixes the STG/tag-inference analogue of #15226. Co-Authored-By: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 34f06334 by Moritz Angermann at 2023-10-28T07:06:53-04:00 [PEi386] Mask SYM_TYPE_DUP_DISCARD in makeSymbolExtra 48e391952c17ff7eab10b0b1456e3f2a2af28a9b introduced `SYM_TYPE_DUP_DISCARD` to the bitfield. The linker however, failed to mask the `SYM_TYPE_DUP_DISCARD` value. Thus `== SYM_TYPE_CODE` comparisons easily failed. This lead to us relocating DATA lookups (GOT) into E8 (call) and E9 (jump) instructions. - - - - - 5b51b2a2 by Mario Blažević at 2023-10-28T07:07:33-04:00 Fix and test for issue #24111, TH.Ppr output of pattern synonyms - - - - - 723bc352 by Alan Zimmerman at 2023-10-30T20:36:41-04:00 EPA: print doc comments as normal comments And ignore the ones allocated in haddock processing. It does not guarantee that every original haddock-like comment appears in the output, as it discards ones that have no legal attachment point. closes #23459 - - - - - 21b76843 by Simon Peyton Jones at 2023-10-30T20:37:17-04:00 Fix non-termination bug in equality solver constraint left-to-right then right to left, forever. Easily fixed. - - - - - 270867ac by Sebastian Graf at 2023-10-30T20:37:52-04:00 ghc-toolchain: build with `-package-env=-` (#24131) Otherwise globally installed libraries (via `cabal install --lib`) break the build. Fixes #24131. - - - - - 7a90020f by Krzysztof Gogolewski at 2023-10-31T20:03:37-04:00 docs: fix ScopedTypeVariables example (#24101) The previous example didn't compile. Furthermore, it wasn't demonstrating the point properly. I have changed it to an example which shows that 'a' in the signature must be the same 'a' as in the instance head. - - - - - 49f69f50 by Krzysztof Gogolewski at 2023-10-31T20:04:13-04:00 Fix pretty-printing of type family dependencies "where" should be after the injectivity annotation. - - - - - 73c191c0 by Ben Gamari at 2023-10-31T20:04:49-04:00 gitlab-ci: Bump LLVM bootstrap jobs to Debian 12 As the Debian 10 images have too old an LLVM. Addresses #24056. - - - - - 5b0392e0 by Matthew Pickering at 2023-10-31T20:04:49-04:00 ci: Run aarch64 llvm backend job with "LLVM backend" label This brings it into line with the x86 LLVM backend job. - - - - - 9f9c9227 by Ryan Scott at 2023-11-01T09:19:12-04:00 More robust checking for DataKinds As observed in #22141, GHC was not doing its due diligence in catching code that should require `DataKinds` in order to use. Most notably, it was allowing the use of arbitrary data types in kind contexts without `DataKinds`, e.g., ```hs data Vector :: Nat -> Type -> Type where ``` This patch revamps how GHC tracks `DataKinds`. The full specification is written out in the `DataKinds` section of the GHC User's Guide, and the implementation thereof is described in `Note [Checking for DataKinds]` in `GHC.Tc.Validity`. In brief: * We catch _type_-level `DataKinds` violations in the renamer. See `checkDataKinds` in `GHC.Rename.HsType` and `check_data_kinds` in `GHC.Rename.Pat`. * We catch _kind_-level `DataKinds` violations in the typechecker, as this allows us to catch things that appear beneath type synonyms. (We do *not* want to do this in type-level contexts, as it is perfectly fine for a type synonym to mention something that requires DataKinds while still using the type synonym in a module that doesn't enable DataKinds.) See `checkValidType` in `GHC.Tc.Validity`. * There is now a single `TcRnDataKindsError` that classifies all manner of `DataKinds` violations, both in the renamer and the typechecker. The `NoDataKindsDC` error has been removed, as it has been subsumed by `TcRnDataKindsError`. * I have added `CONSTRAINT` is `isKindTyCon`, which is what checks for illicit uses of data types at the kind level without `DataKinds`. Previously, `isKindTyCon` checked for `Constraint` but not `CONSTRAINT`. This is inconsistent, given that both `Type` and `TYPE` were checked by `isKindTyCon`. Moreover, it thwarted the implementation of the `DataKinds` check in `checkValidType`, since we would expand `Constraint` (which was OK without `DataKinds`) to `CONSTRAINT` (which was _not_ OK without `DataKinds`) and reject it. Now both are allowed. * I have added a flurry of additional test cases that test various corners of `DataKinds` checking. Fixes #22141. - - - - - 575d7690 by Sylvain Henry at 2023-11-01T09:19:53-04:00 JS: fix FFI "wrapper" and "dynamic" Fix codegen and helper functions for "wrapper" and "dynamic" foreign imports. Fix tests: - ffi006 - ffi011 - T2469 - T4038 Related to #22363 - - - - - 81fb8885 by Alan Zimmerman at 2023-11-01T22:23:56-04:00 EPA: Use full range for Anchor This change requires a series of related changes, which must all land at the same time, otherwise all the EPA tests break. * Use the current Anchor end as prior end Use the original anchor location end as the source of truth for calculating print deltas. This allows original spacing to apply in most cases, only changed AST items need initial delta positions. * Add DArrow to TrailingAnn * EPA Introduce HasTrailing in ExactPrint Use [TrailingAnn] in enterAnn and remove it from ExactPrint (LocatedN RdrName) * In HsDo, put TrailingAnns at top of LastStmt * EPA: do not convert comments to deltas when balancing. * EPA: deal with fallout from getMonoBind * EPA fix captureLineSpacing * EPA print any comments in the span before exiting it * EPA: Add comments to AnchorOperation * EPA: remove AnnEofComment, it is no longer used Updates Haddock submodule - - - - - 03e82511 by Rodrigo Mesquita at 2023-11-01T22:24:32-04:00 Fix in docs regarding SSymbol, SNat, SChar (#24119) - - - - - 362cc693 by Matthew Pickering at 2023-11-01T22:25:08-04:00 hadrian: Update bootstrap plans (9.4.6, 9.4.7, 9.6.2, 9.6.3, 9.8.1) Updating the bootstrap plans with more recent GHC versions. - - - - - 00b9b8d3 by Matthew Pickering at 2023-11-01T22:25:08-04:00 ci: Add 9.8.1 bootstrap testing job - - - - - ef3d20f8 by Matthew Pickering at 2023-11-01T22:25:08-04:00 Compatibility with 9.8.1 as boot compiler This fixes several compatability issues when using 9.8.1 as the boot compiler. * An incorrect version guard on the stack decoding logic in ghc-heap * Some ghc-prim bounds need relaxing * ghc is no longer wired in, so we have to remove the -this-unit-id ghc call. Fixes #24077 - - - - - 6755d833 by Jaro Reinders at 2023-11-03T10:54:42+01:00 Add NCG support for common 64bit operations to the x86 backend. These used to be implemented via C calls which was obviously quite bad for performance for operations like simple addition. Co-authored-by: Andreas Klebinger - - - - - 0dfb1fa7 by Vladislav Zavialov at 2023-11-03T14:08:41-04:00 T2T in Expressions (#23738) This patch implements the T2T (term-to-type) transformation in expressions. Given a function with a required type argument vfun :: forall a -> ... the user can now call it as vfun (Maybe Int) instead of vfun (type (Maybe Int)) The Maybe Int argument is parsed and renamed as a term (HsExpr), but then undergoes a conversion to a type (HsType). See the new function expr_to_type in compiler/GHC/Tc/Gen/App.hs and Note [RequiredTypeArguments and the T2T mapping] Left as future work: checking for puns. - - - - - cc1c7c54 by Duncan Coutts at 2023-11-05T00:23:44-04:00 Add a test for I/O managers It tries to cover the cases of multiple threads waiting on the same fd for reading and multiple threads waiting for writing, including wait cancellation by async exceptions. It should work for any I/O manager, in-RTS or in-Haskell. Unfortunately it will not currently work for Windows because it relies on anonymous unix sockets. It could in principle be ported to use Windows named pipes. - - - - - 2e448f98 by Cheng Shao at 2023-11-05T00:23:44-04:00 Skip the IOManager test on wasm32 arch. The test relies on the sockets API which are not (yet) available. - - - - - fe50eb35 by Cheng Shao at 2023-11-05T00:24:20-04:00 compiler: fix eager blackhole symbol in wasm32 NCG - - - - - af771148 by Cheng Shao at 2023-11-05T00:24:20-04:00 testsuite: fix optasm tests for wasm32 - - - - - 1b90735c by Matthew Pickering at 2023-11-05T00:24:20-04:00 testsuite: Add wasm32 to testsuite arches with NCG The compiler --info reports that wasm32 compilers have a NCG, so we should agree with that here. - - - - - db9a6496 by Alan Zimmerman at 2023-11-05T00:24:55-04:00 EPA: make locA a function, not a field name And use it to generalise reLoc The following for the windows pipeline one. 5.5% Metric Increase: T5205 - - - - - 833e250c by Simon Peyton Jones at 2023-11-05T00:25:31-04:00 Update the unification count in wrapUnifierX Omitting this caused type inference to fail in #24146. This was an accidental omision in my refactoring of the equality solver. - - - - - e451139f by Andreas Klebinger at 2023-11-05T00:26:07-04:00 Remove an accidental git conflict marker from a comment. - - - - - 30baac7a by Tobias Haslop at 2023-11-06T10:50:32+00:00 Add laws relating between Foldable/Traversable with their Bi- superclasses See https://github.com/haskell/core-libraries-committee/issues/205 for discussion. This commit also documents that the tuple instances only satisfy the laws up to lazyness, similar to the documentation added in !9512. - - - - - df626f00 by Tobias Haslop at 2023-11-07T02:20:37-05:00 Elaborate on the quantified superclass of Bifunctor This was requested in the comment https://github.com/haskell/core-libraries-committee/issues/93#issuecomment-1597271700 for when Traversable becomes a superclass of Bitraversable, but similarly applies to Functor/Bifunctor, which already are in a superclass relationship. - - - - - 8217acb8 by Alan Zimmerman at 2023-11-07T02:21:12-05:00 EPA: get rid of l2l and friends Replace them with l2l to convert the location la2la to convert a GenLocated thing Updates haddock submodule - - - - - dd88a260 by Luite Stegeman at 2023-11-07T02:21:53-05:00 JS: remove broken newIdents from JStg Monad GHC.JS.JStg.Monad.newIdents was broken, resulting in duplicate identifiers being generated in h$c1, h$c2, ... . This change removes the broken newIdents. - - - - - 455524a2 by Matthew Craven at 2023-11-09T08:41:59-05:00 Create specially-solved DataToTag class Closes #20532. This implements CLC proposal 104: https://github.com/haskell/core-libraries-committee/issues/104 The design is explained in Note [DataToTag overview] in GHC.Tc.Instance.Class. This replaces the existing `dataToTag#` primop. These metric changes are not "real"; they represent Unique-related flukes triggering on a different set of jobs than they did previously. See also #19414. Metric Decrease: T13386 T8095 Metric Increase: T13386 T8095 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - a05f4554 by Alan Zimmerman at 2023-11-09T08:42:35-05:00 EPA: get rid of glRR and friends in GHC/Parser.y With the HasLoc and HasAnnotation classes, we can replace a number of type-specific helper functions in the parser with polymorphic ones instead Metric Decrease: MultiLayerModulesTH_Make - - - - - 18498538 by Cheng Shao at 2023-11-09T16:58:12+00:00 ci: bump ci-images for wasi-sdk upgrade - - - - - 52c0fc69 by PHO at 2023-11-09T19:16:22-05:00 Don't assume the current locale is *.UTF-8, set the encoding explicitly primops.txt contains Unicode characters: > LC_ALL=C ./genprimopcode --data-decl < ./primops.txt > genprimopcode: <stdin>: hGetContents: invalid argument (cannot decode byte sequence starting from 226) Hadrian must also avoid using readFile' to read primops.txt because it tries to decode the file with a locale-specific encoding. - - - - - 7233b3b1 by PHO at 2023-11-09T19:17:01-05:00 Use '[' instead of '[[' because the latter is a Bash-ism It doesn't work on platforms where /bin/sh is something other than Bash. - - - - - 6dbab180 by Simon Peyton Jones at 2023-11-09T19:17:36-05:00 Add an extra check in kcCheckDeclHeader_sig Fix #24083 by checking for a implicitly-scoped type variable that is not actually bound. See Note [Disconnected type variables] in GHC.Tc.Gen.HsType For some reason, on aarch64-darwin we saw a 2.8% decrease in compiler allocations for MultiLayerModulesTH_Make; but 0.0% on other architectures. Metric Decrease: MultiLayerModulesTH_Make - - - - - 22551364 by Sven Tennie at 2023-11-11T06:35:22-05:00 AArch64: Delete unused LDATA pseudo-instruction Though there were consuming functions for LDATA, there were no producers. Thus, the removed code was "dead". - - - - - 2a0ec8eb by Alan Zimmerman at 2023-11-11T06:35:59-05:00 EPA: harmonise acsa and acsA in GHC/Parser.y With the HasLoc class, we can remove the acsa helper function, using acsA instead. - - - - - 7ae517a0 by Teo Camarasu at 2023-11-12T08:04:12-05:00 nofib: bump submodule This includes changes that: - fix building a benchmark with HEAD - remove a Makefile-ism that causes errors in bash scripts Resolves #24178 - - - - - 3f0036ec by Alan Zimmerman at 2023-11-12T08:04:47-05:00 EPA: Replace Anchor with EpaLocation An Anchor has a location and an operation, which is either that it is unchanged or that it has moved with a DeltaPos data Anchor = Anchor { anchor :: RealSrcSpan , anchor_op :: AnchorOperation } An EpaLocation also has either a location or a DeltaPos data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | EpaDelta !DeltaPos ![LEpaComment] Now that we do not care about always having a location in the anchor, we remove Anchor and replace it with EpaLocation We do this with a type alias initially, to ease the transition. The alias will be removed in time. We also have helpers to reconstruct the AnchorOperation from an EpaLocation. This is also temporary. Updates Haddock submodule - - - - - a7492048 by Alan Zimmerman at 2023-11-12T13:43:07+00:00 EPA: get rid of AnchorOperation Now that the Anchor type is an alias for EpaLocation, remove AnchorOperation. Updates haddock submodule - - - - - 0745c34d by Andrew Lelechenko at 2023-11-13T16:25:07-05:00 Add since annotation for showHFloat - - - - - e98051a5 by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 Suppress duplicate librares linker warning of new macOS linker Fixes #24167 XCode 15 introduced a new linker which warns on duplicate libraries being linked. To disable this warning, we pass -Wl,-no_warn_duplicate_libraries as suggested by Brad King in CMake issue #25297. This flag isn't necessarily available to other linkers on darwin, so we must only configure it into the CC linker arguments if valid. - - - - - c411c431 by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 testsuite: Encoding test witnesses recent iconv bug is fragile A regression in the new iconv() distributed with XCode 15 and MacOS Sonoma causes the test 'encoding004' to fail in the CP936 roundrip. We mark this test as fragile until this is fixed upstream (rather than broken, since previous versions of iconv pass the test) See #24161 - - - - - ce7fe5a9 by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 testsuite: Update to LC_ALL=C no longer being ignored in darwin MacOS seems to have fixed an issue where it used to ignore the variable `LC_ALL` in program invocations and default to using Unicode. Since the behaviour seems to be fixed to account for the locale variable, we mark tests that were previously broken in spite of it as fragile (since they now pass in recent macOS distributions) See #24161 - - - - - e6c803f7 by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 darwin: Fix single_module is obsolete warning In XCode 15's linker, -single_module is the default and otherwise passing it as a flag results in a warning being raised: ld: warning: -single_module is obsolete This patch fixes this warning by, at configure time, determining whether the linker supports -single_module (which is likely false for all non-darwin linkers, and true for darwin linkers in previous versions of macOS), and using that information at runtime to decide to pass or not the flag in the invocation. Fixes #24168 - - - - - 929ba2f9 by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 testsuite: Skip MultiLayerModulesTH_Make on darwin The recent toolchain upgrade on darwin machines resulted in the MultiLayerModulesTH_Make test metrics varying too much from the baseline, ultimately blocking the CI pipelines. This commit skips the test on darwin to temporarily avoid failures due to the environment change in the runners. However, the metrics divergence is being investigated still (tracked in #24177) - - - - - af261ccd by Rodrigo Mesquita at 2023-11-15T13:18:58-05:00 configure: check target (not build) understands -no_compact_unwind Previously, we were branching on whether the build system was darwin to shortcut this check, but we really want to branch on whether the target system (which is what we are configuring ld_prog for) is darwin. - - - - - 2125c176 by Luite Stegeman at 2023-11-15T13:19:38-05:00 JS: Fix missing variable declarations The JStg IR update was missing some local variable declarations that were present earlier, causing global variables to be used implicitly (or an error in JavaScript strict mode). This adds the local variable declarations again. - - - - - 99ced73b by Krzysztof Gogolewski at 2023-11-15T13:20:14-05:00 Remove loopy superclass solve mechanism Programs with a -Wloopy-superclass-solve warning will now fail with an error. Fixes #23017 - - - - - 2aff2361 by Zubin Duggal at 2023-11-15T13:20:50-05:00 users-guide: Fix links to libraries from the users-guide. The unit-ids generated in c1a3ecde720b3bddc2c8616daaa06ee324e602ab include the package name, so we don't need to explicitly add it to the links. Fixes #24151 - - - - - 27981fac by Alan Zimmerman at 2023-11-15T13:21:25-05:00 EPA: splitLHsForAllTyInvis does not return ann We did not use the annotations returned from splitLHsForAllTyInvis, so do not return them. - - - - - a6467834 by Krzysztof Gogolewski at 2023-11-15T22:22:59-05:00 Document defaulting of RuntimeReps Fixes #24099 - - - - - 2776920e by Simon Peyton Jones at 2023-11-15T22:23:35-05:00 Second fix to #24083 My earlier fix turns out to be too aggressive for data/type families See wrinkle (DTV1) in Note [Disconnected type variables] - - - - - cee81370 by Sylvain Henry at 2023-11-16T09:57:46-05:00 Fix unusable units and module reexport interaction (#21097) This commit fixes an issue with ModUnusable introduced in df0f148feae. In mkUnusableModuleNameProvidersMap we traverse the list of unusable units and generate ModUnusable origin for all the modules they contain: exposed modules, hidden modules, and also re-exported modules. To do this we have a two-level map: ModuleName -> Unit:ModuleName (aka Module) -> ModuleOrigin So for each module name "M" in broken unit "u" we have: "M" -> u:M -> ModUnusable reason However in the case of module reexports we were using the *target* module as a key. E.g. if "u:M" is a reexport for "X" from unit "o": "M" -> o:X -> ModUnusable reason Case 1: suppose a reexport without module renaming (u:M -> o:M) from unusable unit u: "M" -> o:M -> ModUnusable reason Here it's claiming that the import of M is unusable because a reexport from u is unusable. But if unit o isn't unusable we could also have in the map: "M" -> o:M -> ModOrigin ... Issue: the Semigroup instance of ModuleOrigin doesn't handle the case (ModUnusable <> ModOrigin) Case 2: similarly we could have 2 unusable units reexporting the same module without renaming, say (u:M -> o:M) and (v:M -> o:M) with u and v unusable. It gives: "M" -> o:M -> ModUnusable ... (for u) "M" -> o:M -> ModUnusable ... (for v) Issue: the Semigroup instance of ModuleOrigin doesn't handle the case (ModUnusable <> ModUnusable). This led to #21097, #16996, #11050. To fix this, in this commit we make ModUnusable track whether the module used as key is a reexport or not (for better error messages) and we use the re-export module as key. E.g. if "u:M" is a reexport for "o:X" and u is unusable, we now record: "M" -> u:M -> ModUnusable reason reexported=True So now, we have two cases for a reexport u:M -> o:X: - u unusable: "M" -> u:M -> ModUnusable ... reexported=True - u usable: "M" -> o:X -> ModOrigin ... reexportedFrom=u:M The second case is indexed with o:X because in this case the Semigroup instance of ModOrigin is used to combine valid expositions of a module (directly or via reexports). Note that module lookup functions select usable modules first (those who have a ModOrigin value), so it doesn't matter if we add new ModUnusable entries in the map like this: "M" -> { u:M -> ModUnusable ... reexported=True o:M -> ModOrigin ... } The ModOrigin one will be used. Only if there is no ModOrigin or ModHidden entry will the ModUnusable error be printed. See T21097 for an example printing several reasons why an import is unusable. - - - - - 3e606230 by Krzysztof Gogolewski at 2023-11-16T09:58:22-05:00 Fix IPE test A helper function was defined in a different module than used. To reproduce: ./hadrian/build test --test-root-dirs=testsuite/tests/rts/ipe - - - - - 49f5264b by Andreas Klebinger at 2023-11-16T20:52:11-05:00 Properly compute unpacked sizes for -funpack-small-strict-fields. Use rep size rather than rep count to compute the size. Fixes #22309 - - - - - b4f84e4b by James Henri Haydon at 2023-11-16T20:52:53-05:00 Explicit methods for Alternative Compose Explicitly define some and many in Alternative instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/181 - - - - - 9bc0dd1f by Ignat Insarov at 2023-11-16T20:53:34-05:00 Add permutations for non-empty lists. Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/68#issuecomment-1221409837 - - - - - 5643ecf9 by Andrew Lelechenko at 2023-11-16T20:53:34-05:00 Update changelog and since annotations for Data.List.NonEmpty.permutations Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/68#issuecomment-1221409837 - - - - - 94ff2134 by Oleg Alexander at 2023-11-16T20:54:15-05:00 Update doc string for traceShow Updated doc string for traceShow. - - - - - faff671a by Luite Stegeman at 2023-11-17T14:12:51+01:00 JS: clean up some foreign imports - - - - - 856e0a4e by Sven Tennie at 2023-11-18T06:54:11-05:00 AArch64: Remove unused instructions As these aren't ever emitted, we don't even know if they work or will ever be used. If one of them is needed in future, we may easily re-add it. Deleted instructions are: - CMN - ANDS - BIC - BICS - EON - ORN - ROR - TST - STP - LDP - DMBSY - - - - - 615441ef by Alan Zimmerman at 2023-11-18T06:54:46-05:00 EPA: Replace Monoid with NoAnn Remove the final Monoid instances in the exact print infrastructure. For Windows CI Metric Decrease: T5205 - - - - - 5a6c49d4 by David Feuer at 2023-11-20T18:53:18-05:00 Speed up stimes in instance Semigroup Endo As discussed at https://github.com/haskell/core-libraries-committee/issues/4 - - - - - cf9da4b3 by Andrew Lelechenko at 2023-11-20T18:53:18-05:00 base: reflect latest changes in the changelog - - - - - 48bf364e by Alan Zimmerman at 2023-11-20T18:53:54-05:00 EPA: Use SrcSpan in EpaSpan This is more natural, since we already need to deal with invalid RealSrcSpans, and that is exactly what SrcSpan.UnhelpfulSpan is for. Updates haddock submodule. - - - - - 97ec37cc by Sebastian Graf at 2023-11-20T18:54:31-05:00 Add regression test for #6070 Fixes #6070. - - - - - e9d5ae41 by Owen Shepherd at 2023-11-21T18:32:23-05:00 chore: Correct typo in the gitlab MR template [skip ci] - - - - - f158a8d0 by Rodrigo Mesquita at 2023-11-21T18:32:59-05:00 Improve error message when reading invalid `.target` files A `.target` file generated by ghc-toolchain or by configure can become invalid if the target representation (`Toolchain.Target`) is changed while the files are not re-generated by calling `./configure` or `ghc-toolchain` again. There is also the issue of hadrian caching the dependencies on `.target` files, which makes parsing fail when reading reading the cached value if the representation has been updated. This patch provides a better error message in both situations, moving away from a terrible `Prelude.read: no parse` error that you would get otherwise. Fixes #24199 - - - - - 955520c6 by Ben Gamari at 2023-11-21T18:33:34-05:00 users guide: Note that QuantifiedConstraints implies ExplicitForAll Fixes #24025. - - - - - 17ec3e97 by Owen Shepherd at 2023-11-22T09:37:28+01:00 fix: Change type signatures in NonEmpty export comments to reflect reality This fixes several typos in the comments of Data.List.NonEmpty export list items. - - - - - 2fd78f9f by Samuel Thibault at 2023-11-22T11:49:13-05:00 Fix the platform string for GNU/Hurd As commited in Cargo https://github.com/haskell/cabal/pull/9434 there is confusion between "gnu" and "hurd". This got fixed in Cargo, we need the converse in Hadrian. Fixes #24180 - - - - - a79960fe by Alan Zimmerman at 2023-11-22T11:49:48-05:00 EPA: Tuple Present no longer has annotation The Present constructor for a Tuple argument will never have an exact print annotation. So make this impossible. - - - - - 121c9ab7 by David Binder at 2023-11-22T21:12:29-05:00 Unify the hpc testsuites The hpc testsuite was split between testsuite/tests/hpc and the submodule libraries/hpc/test. This commit unifies the two testsuites in the GHC repository in the directory testsuite/tests/hpc. - - - - - d2733a05 by Alan Zimmerman at 2023-11-22T21:13:05-05:00 EPA: empty tup_tail has noAnn In Parser.y, the tup_tail rule had the following option | {- empty -} %shift { return [Left noAnn] } Once this works through PostProcess.hs, it means we add an extra Missing constructor if the last item was a comma. Change the annotation type to a Bool to indicate this, and use the EpAnn Anchor for the print location for the others. - - - - - fa576eb8 by Andreas Klebinger at 2023-11-24T08:29:13-05:00 Fix FMA primops generating broken assembly on x86. `genFMA3Code` assumed that we had to take extra precations to avoid overwriting the result of `getNonClobberedReg`. One of these special cases caused a bug resulting in broken assembly. I believe we don't need to hadle these cases specially at all, which means this MR simply deletes the special cases to fix the bug. Fixes #24160 - - - - - 34d86315 by Alan Zimmerman at 2023-11-24T08:29:49-05:00 EPA: Remove parenthesizeHsType This is called from PostProcess.hs, and adds spurious parens. With the looser version of exact printing we had before we could tolerate this, as they would be swallowed by the original at the same place. But with the next change (remove EpAnnNotUsed) they result in duplicates in the output. For Darwin build: Metric Increase: MultiLayerModulesTH_OneShot - - - - - 3ede659d by Vladislav Zavialov at 2023-11-26T06:43:32-05:00 Add name for -Wdeprecated-type-abstractions (#24154) This warning had no name or flag and was triggered unconditionally. Now it is part of -Wcompat. - - - - - 7902ebf8 by Alan Zimmerman at 2023-11-26T06:44:08-05:00 EPA: Remove EpAnnNotUsed We no longer need the EpAnnNotUsed constructor for EpAnn, as we can represent an unused annotation with an anchor having a EpaDelta of zero, and empty comments and annotations. This simplifies code handling annotations considerably. Updates haddock submodule Metric Increase: parsing001 - - - - - 471b2672 by Mario Blažević at 2023-11-26T06:44:48-05:00 Bumped the upper bound of text to <2.2 - - - - - d1bf25c7 by Vladislav Zavialov at 2023-11-26T11:45:49-05:00 Term variable capture (#23740) This patch changes type variable lookup rules (lookupTypeOccRn) and implicit quantification rules (filterInScope) so that variables bound in the term namespace can be captured at the type level {-# LANGUAGE RequiredTypeArguments #-} f1 x = g1 @x -- `x` used in a type application f2 x = g2 (undefined :: x) -- `x` used in a type annotation f3 x = g3 (type x) -- `x` used in an embedded type f4 x = ... where g4 :: x -> x -- `x` used in a type signature g4 = ... This change alone does not allow us to accept examples shown above, but at least it gets them past the renamer. - - - - - da863d15 by Vladislav Zavialov at 2023-11-26T11:46:26-05:00 Update Note [hsScopedTvs and visible foralls] The Note was written before GHC gained support for visible forall in types of terms. Rewrite a few sentences and use a better example. - - - - - b5213542 by Matthew Pickering at 2023-11-27T12:53:59-05:00 testsuite: Add mechanism to collect generic metrics * Generalise the metric logic by adding an additional field which allows you to specify how to query for the actual value. Previously the method of querying the baseline value was abstracted (but always set to the same thing). * This requires rejigging how the stat collection works slightly but now it's more uniform and hopefully simpler. * Introduce some new "generic" helper functions for writing generic stats tests. - collect_size ( deviation, path ) Record the size of the file as a metric - stat_from_file ( metric, deviation, path ) Read a value from the given path, and store that as a metric - collect_generic_stat ( metric, deviation, get_stat) Provide your own `get_stat` function, `lambda way: <Int>`, which can be used to establish the current value of the metric. - collect_generic_stats ( metric_info ): Like collect_generic_stat but provide the whole dictionary of metric definitions. { metric: { deviation: <Int> current: lambda way: <Int> } } * Introduce two new "size" metrics for keeping track of build products. - `size_hello_obj` - The size of `hello.o` from compiling hello.hs - `libdir` - The total size of the `libdir` folder. * Track the number of modules in the AST tests - CountDepsAst - CountDepsParser This lays the infrastructure for #24191 #22256 #17129 - - - - - 7d9a2e44 by ARATA Mizuki at 2023-11-27T12:54:39-05:00 x86: Don't require -mavx2 when using 256-bit floating-point SIMD primitives Fixes #24222 - - - - - 4e5ff6a4 by Alan Zimmerman at 2023-11-27T12:55:15-05:00 EPA: Remove SrcSpanAnn Now that we only have a single constructor for EpAnn, And it uses a SrcSpan for its location, we can do away with SrcSpanAnn completely. It only existed to wrap the original SrcSpan in a location, and provide a place for the exact print annotation. For darwin only: Metric Increase: MultiLayerModulesTH_OneShot Updates haddock submodule - - - - - e05bca39 by Krzysztof Gogolewski at 2023-11-28T08:00:55-05:00 testsuite: don't initialize testdir to '.' The test directory is removed during cleanup, if there's an interrupt that could remove the entire repository. Fixes #24219 - - - - - af881674 by Alan Zimmerman at 2023-11-28T08:01:30-05:00 EPA: Clean up mkScope in Ast.hs Now that we have HasLoc we can get rid of all the custom variants of mkScope For deb10-numa Metric Increase: libdir - - - - - 292983c8 by Ben Gamari at 2023-11-28T22:44:28-05:00 distrib: Rediscover otool and install_name_tool on Darwin In the bindist configure script we must rediscover the `otool` and `install_name_tool`s since they may be different from the build environment. Fixes #24211. - - - - - dfe1c354 by Stefan Schulze Frielinghaus at 2023-11-28T22:45:04-05:00 llvmGen: Align objects in the data section Objects in the data section may be referenced via tagged pointers. Thus, align those objects to a 4- or 8-byte boundary for 32- or 64-bit platforms, respectively. Note, this may need to be reconsidered if objects with a greater natural alignment requirement are emitted as e.g. 128-bit atomics. Fixes #24163. - - - - - f6c486c3 by Matthew Pickering at 2023-11-29T11:08:13-05:00 metrics: Widen libdir and size_hello_obj acceptance window af8816740d9b8759be1a22af8adcb5f13edeb61d shows that the libdir size can fluctuate quite significantly even when the change is quite small. Therefore we widen the acceptance window to 10%. - - - - - 99a6a49c by Alan Zimmerman at 2023-11-29T11:08:49-05:00 EPA: Clean up TC Monad Utils We no longer need the alternative variant of addLocM (addLocMA) nor wrapLocAM, wrapLocSndMA. aarch64-darwin Metric Increase: MultiLayerModulesTH_OneShot deb10-numa-slow Metric Decrease: libdir - - - - - cbc03fa0 by Sebastian Graf at 2023-11-30T12:37:21-05:00 perf tests: Move comments into new `Note [Sensitivity to unique increment]` (#19414) And additionally to T12545, link from T8095, T13386 to this new Note. - - - - - c7623b22 by Alan Zimmerman at 2023-11-30T12:37:56-05:00 EPA: EpaDelta for comment has no comments EpaLocation is used to position things. It has two constructors, EpaSpan holding a SrcSpan, and EpaDelta with a delta position and a possible list of comments. The comment list is needed because the location in EpaDelta has no absolute information to decide which comments should be emitted before them when printing. But it is also used for specifying the position of a comment. To prevent the absurdity of a comment position having a list of comments in it, we make EpaLocation parameterisable, using comments for the normal case and a constant for within comments. Updates haddock submodule. aarch64-darwin Metric Decrease: MultiLayerModulesTH_OneShot - - - - - bd8acc0c by Krzysztof Gogolewski at 2023-11-30T12:38:32-05:00 Kind-check body of a required forall We now require that in 'forall a -> ty', ty has kind TYPE r for some r. Fixes #24176 - - - - - 010fb784 by Owen Shepherd at 2023-12-03T00:10:09-05:00 docs(NonEmpty/group): Remove incorrect haddock link quotes in code block - - - - - cda9c12d by Owen Shepherd at 2023-12-03T00:10:09-05:00 docs(NonEmpty/group): Remove cycle from group haddock example - - - - - 495265b9 by Owen Shepherd at 2023-12-03T00:10:09-05:00 docs(NonEmpty/group): Use repl haddock syntax in group docs - - - - - d134d1de by Owen Shepherd at 2023-12-03T00:10:09-05:00 docs(NonEmpty/group): Use list [] notation in group haddock - - - - - dfcf629c by Owen Shepherd at 2023-12-03T00:10:10-05:00 docs(NonEmpty/group): Specify final property of group function in haddock - - - - - cad3b734 by Owen Shepherd at 2023-12-03T00:10:10-05:00 fix: Add missing property of List.group - - - - - bad37656 by Matthew Pickering at 2023-12-03T00:10:46-05:00 testsuite: Fix T21097b test with make 4.1 (deb9) cee81370cd6ef256f66035e3116878d4cb82e28b recently added a test which failed on deb9 because the version of make was emitting the recipe failure to stdout rather than stderr. One way to fix this is to be more precise in the test about which part of the output we care about inspecting. - - - - - 5efdf421 by Matthew Pickering at 2023-12-03T00:11:21-05:00 testsuite: Track size of libdir in bytes For consistency it's better if we track all size metrics in bytes. Metric Increase: libdir - - - - - f5eb0f29 by Matthew Pickering at 2023-12-03T00:11:22-05:00 testsuite: Remove rogue trace in testsuite I accidentally left a trace in the generics metric patch. - - - - - d5610737 by Claudio Bley at 2023-12-06T16:13:33-05:00 Only exit ghci in -e mode when :add command fails Previously, when running `ghci -e ':add Sample.hs'` the process would exit with exit code 1 if the file exists and could be loaded. Fixes #24115 - - - - - 0f0c53a5 by Vladislav Zavialov at 2023-12-06T16:14:09-05:00 T2T in Patterns (#23739) This patch implements the T2T (term-to-type) transformation in patterns. Patterns that are checked against a visible forall can now be written without the `type` keyword: \(type t) (x :: t) -> ... -- old \t (x :: t) -> ... -- new The `t` binder is parsed and renamed as a term pattern (Pat), but then undergoes a conversion to a type pattern (HsTyPat). See the new function pat_to_type_pat in compiler/GHC/Tc/Gen/Pat.hs - - - - - 10a1a6c6 by Sebastian Graf at 2023-12-06T16:14:45-05:00 Pmc: Fix SrcLoc and warning for incomplete irrefutable pats (#24234) Before, the source location would point at the surrounding function definition, causing the confusion in #24234. I also took the opportunity to introduce a new `LazyPatCtx :: HsMatchContext _` to make the warning message say "irrefutable pattern" instead of "pattern binding". - - - - - 36b9a38c by Matthew Pickering at 2023-12-06T16:15:21-05:00 libraries: Bump filepath to 1.4.200.1 and unix to 2.8.4.0 Updates filepath submodule Updates unix submodule Fixes #24240 - - - - - 91ff0971 by Matthew Pickering at 2023-12-06T16:15:21-05:00 Submodule linter: Allow references to tags We modify the submodule linter so that if the bumped commit is a specific tag then the commit is accepted. Fixes #24241 - - - - - 86f652dc by Zubin Duggal at 2023-12-06T16:15:21-05:00 hadrian: set -Wno-deprecations for directory and Win32 The filepath bump to 1.4.200.1 introduces a deprecation warning. See https://gitlab.haskell.org/ghc/ghc/-/issues/24240 https://github.com/haskell/filepath/pull/206 - - - - - 7ac6006e by Sylvain Henry at 2023-12-06T16:16:02-05:00 Zap OccInfo on case binders during StgCse #14895 #24233 StgCse can revive dead binders: case foo of dead { Foo x y -> Foo x y; ... } ===> case foo of dead { Foo x y -> dead; ... } -- dead is no longer dead So we must zap occurrence information on case binders. Fix #14895 and #24233 - - - - - 57c391c4 by Sebastian Graf at 2023-12-06T16:16:37-05:00 Cpr: Turn an assertion into a check to deal with some dead code (#23862) See the new `Note [Dead code may contain type confusions]`. Fixes #23862. - - - - - c1c8abf8 by Zubin Duggal at 2023-12-08T02:25:07-05:00 testsuite: add test for #23944 - - - - - 6329d308 by Zubin Duggal at 2023-12-08T02:25:07-05:00 driver: Only run a dynamic-too pipeline if object files are going to be generated Otherwise we run into a panic in hscMaybeWriteIface: "Unexpected DT_Dyn state when writing simple interface" when dynamic-too is enabled We could remove the panic and just write the interface even if the state is `DT_Dyn`, but it seems pointless to run the pipeline twice when `hscMaybeWriteIface` is already designed to write both `hi` and `dyn_hi` files if dynamic-too is enabled. Fixes #23944. - - - - - 28811f88 by Simon Peyton Jones at 2023-12-08T05:47:18-05:00 Improve duplicate elimination in SpecConstr This partially fixes #24229. See the new Note [Pattern duplicate elimination] in SpecConstr - - - - - fec7894f by Simon Peyton Jones at 2023-12-08T05:47:18-05:00 Make SpecConstr deal with casts better This patch does two things, to fix #23209: * It improves SpecConstr so that it no longer quantifies over coercion variables. See Note [SpecConstr and casts] * It improves the rule matcher to deal nicely with the case where the rule does not quantify over coercion variables, but the the template has a cast in it. See Note [Casts in the template] - - - - - 8db8d2fd by Zubin Duggal at 2023-12-08T05:47:54-05:00 driver: Don't lose track of nodes when we fail to resolve cycles The nodes that take part in a cycle should include both hs-boot and hs files, but when we fail to resolve a cycle, we were only counting the nodes from the graph without boot files. Fixes #24196 - - - - - c5b4efd3 by Zubin Duggal at 2023-12-08T05:48:30-05:00 testsuite: Skip MultiLayerModulesTH_OneShot on darwin See #24177 - - - - - fae472a9 by Wendao Lee at 2023-12-08T05:49:12-05:00 docs(Data.Char):Add more detailed descriptions for some functions Related changed function's docs: -GHC.Unicode.isAlpha -GHC.Unicode.isPrint -GHC.Unicode.isAlphaNum Add more details for what the function will return. Co-authored-by: Bodigrim <andrew.lelechenko at gmail.com> - - - - - ca7510e4 by Malik Ammar Faisal at 2023-12-08T05:49:55-05:00 Fix float parsing in GHC Cmm Lexer Add test case for bug #24224 - - - - - d8baa1bd by Simon Peyton Jones at 2023-12-08T15:40:37+00:00 Take care when simplifying unfoldings This MR fixes a very subtle bug exposed by #24242. See Note [Environment for simplLetUnfolding]. I also updated a bunch of Notes on shadowing - - - - - 03ca551d by Simon Peyton Jones at 2023-12-08T15:54:50-05:00 Comments only in FloatIn Relevant to #3458 - - - - - 50c78779 by Simon Peyton Jones at 2023-12-08T15:54:50-05:00 Comments only in SpecConstr - - - - - 9431e195 by Simon Peyton Jones at 2023-12-08T15:54:50-05:00 Add test for #22238 - - - - - d9e4c597 by Vladislav Zavialov at 2023-12-11T04:19:34-05:00 Make forall a keyword (#23719) Before this change, GHC used to accept `forall` as a term-level identifier: -- from constraints-0.13 forall :: forall p. (forall a. Dict (p a)) -> Dict (Forall p) forall d = ... Now it is a parse error. The -Wforall-identifier warning has served its purpose and is now a deprecated no-op. - - - - - 58d56644 by Zubin Duggal at 2023-12-11T04:20:10-05:00 driver: Ensure we actually clear the interactive context before reloading Previously we called discardIC, but immediately after set the session back to an old HscEnv that still contained the IC Partially addresses #24107 Fixes #23405 - - - - - 8e5745a0 by Zubin Duggal at 2023-12-11T04:20:10-05:00 driver: Ensure we force the lookup of old build artifacts before returning the build plan This prevents us from retaining all previous build artifacts in memory until a recompile finishes, instead only retaining the exact artifacts we need. Fixes #24118 - - - - - 105c370c by Zubin Duggal at 2023-12-11T04:20:10-05:00 testsuite: add test for #24118 and #24107 MultiLayerModulesDefsGhci was not able to catch the leak because it uses :l which discards the previous environment. Using :r catches both of these leaks - - - - - e822ff88 by Zubin Duggal at 2023-12-11T04:20:10-05:00 compiler: Add some strictness annotations to ImportSpec and related constructors This prevents us from retaining entire HscEnvs. Force these ImportSpecs when forcing the GlobalRdrEltX Adds an NFData instance for Bag Fixes #24107 - - - - - 522c12a4 by Zubin Duggal at 2023-12-11T04:20:10-05:00 compiler: Force IfGlobalRdrEnv in NFData instance. - - - - - 188b280d by Arnaud Spiwack at 2023-12-11T15:33:31+01:00 LinearTypes => MonoLocalBinds - - - - - 8e0446df by Arnaud Spiwack at 2023-12-11T15:44:28+01:00 Linear let and where bindings For expediency, the initial implementation of linear types in GHC made it so that let and where binders would always be considered unrestricted. This was rather unpleasant, and probably a big obstacle to adoption. At any rate, this was not how the proposal was designed. This patch fixes this infelicity. It was surprisingly difficult to build, which explains, in part, why it took so long to materialise. As of this patch, let or where bindings marked with %1 will be linear (respectively %p for an arbitrary multiplicity p). Unmarked let will infer their multiplicity. Here is a prototypical example of program that used to be rejected and is accepted with this patch: ```haskell f :: A %1 -> B g :: B %1 -> C h :: A %1 -> C h x = g y where y = f x ``` Exceptions: - Recursive let are unrestricted, as there isn't a clear semantics of what a linear recursive binding would be. - Destructive lets with lazy bindings are unrestricted, as their desugaring isn't linear (see also #23461). - (Strict) destructive lets with inferred polymorphic type are unrestricted. Because the desugaring isn't linear (See #18461 down-thread). Closes #18461 and #18739 Co-authored-by: @jackohughes - - - - - effa7e2d by Matthew Craven at 2023-12-12T04:37:20-05:00 Introduce `dataToTagSmall#` primop (closes #21710) ...and use it to generate slightly better code when dataToTag# is used at a "small data type" where there is no need to mess with "is_too_big_tag" or potentially look at an info table. Metric Decrease: T18304 - - - - - 35c7aef6 by Matthew Craven at 2023-12-12T04:37:20-05:00 Fix formatting of Note [alg-alt heap check] - - - - - 7397c784 by Oleg Grenrus at 2023-12-12T04:37:56-05:00 Allow untyped brackets in typed splices and vice versa. Resolves #24190 Apparently the check was essentially always (as far as I can trace back: d0d47ba76f8f0501cf3c4966bc83966ab38cac27), and while it does catch some mismatches, the type-checker will catch them too. OTOH, it prevents writing completely reasonable programs. - - - - - a3ee3b99 by Moritz Angermann at 2023-12-12T19:50:58-05:00 Drop hard Xcode dependency XCODE_VERSION calls out to `xcodebuild`, which is only available when having `Xcode` installed. The CommandLineTools are not sufficient. To install Xcode, you must have an apple id to download the Xcode.xip from apple. We do not use xcodebuild anywhere in our build explicilty. At best it appears to be a proxy for checking the linker or the compiler. These should rather be done with ``` xcrun ld -version ``` or similar, and not by proxy through Xcode. The CLR should be sufficient for building software on macOS. - - - - - 1c9496e0 by Vladislav Zavialov at 2023-12-12T19:51:34-05:00 docs: update information on RequiredTypeArguments Update the User's Guide and Release Notes to account for the recent progress in the implementation of RequiredTypeArguments. - - - - - d0b17576 by Ben Gamari at 2023-12-13T06:33:37-05:00 rts/eventlog: Fix off-by-one in assertion Previously we failed to account for the NULL terminator `postString` asserted that there is enough room in the buffer for the string. - - - - - a10f9b9b by Ben Gamari at 2023-12-13T06:33:37-05:00 rts/eventlog: Honor result of ensureRoomForVariableEvent is Previously we would keep plugging along, even if isn't enough room for the event. - - - - - 0e0f41c0 by Ben Gamari at 2023-12-13T06:33:37-05:00 rts/eventlog: Avoid truncating event sizes Previously ensureRoomForVariableEvent would truncate the desired size to 16-bits, resulting in #24197. Fixes #24197. - - - - - 64e724c8 by Artin Ghasivand at 2023-12-13T06:34:20-05:00 Remove the "Derived Constraint" argument of TcPluginSolver, docs - - - - - fe6d97dd by Vladislav Zavialov at 2023-12-13T06:34:56-05:00 EPA: Move tokens into GhcPs extension fields (#23447) Summary of changes * Remove Language.Haskell.Syntax.Concrete * Move all tokens into GhcPs extension fields (LHsToken -> EpToken) * Create new TTG extension fields as needed * Drop the MultAnn wrapper Updates the haddock submodule. Co-authored-by: Alan Zimmerman <alan.zimm at gmail.com> - - - - - 8106e695 by Zubin Duggal at 2023-12-13T06:35:34-05:00 testsuite: use copy_files in T23405 This prevents the tree from being dirtied when the file is modified. - - - - - ed0e4099 by Bryan Richter at 2023-12-14T04:30:53-05:00 Document ghc package's PVP-noncompliance This changes nothing, it just makes the status quo explicit. - - - - - 8bef8d9f by Luite Stegeman at 2023-12-14T04:31:33-05:00 JS: Mark spurious CI failures js_fragile(24259) This marks the spurious test failures on the JS platform as js_fragile(24259), so we don't hold up merge requests while fixing the underlying issues. See #24259 - - - - - 1c79526a by Finley McIlwaine at 2023-12-15T12:24:40-08:00 Late plugins - - - - - 000c3302 by Finley McIlwaine at 2023-12-15T12:24:40-08:00 withTiming on LateCCs and late plugins - - - - - be4551ac by Finley McIlwaine at 2023-12-15T12:24:40-08:00 add test for late plugins - - - - - 7c29da9f by Finley McIlwaine at 2023-12-15T12:24:40-08:00 Document late plugins - - - - - 9a52ae46 by Ben Gamari at 2023-12-20T07:07:26-05: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. - - - - - f4b53538 by Vladislav Zavialov at 2023-12-20T07:08:02-05:00 docs: Fix link to 051-ghc-base-libraries.rst The proposal is no longer available at the previous URL. - - - - - f7e21fab by Matthew Pickering at 2023-12-21T14:57:40+00:00 hadrian: Build all executables in bin/ folder In the end the bindist creation logic copies them all into the bin folder. There is no benefit to building a specific few binaries in the lib/bin folder anymore. This also removes the ad-hoc logic to copy the touchy and unlit executables from stage0 into stage1. It takes <1s to build so we might as well just build it. - - - - - 0038d052 by Zubin Duggal at 2023-12-22T23:28:00-05:00 testsuite: mark jspace as fragile on i386. This test has been flaky for some time and has been failing consistently on i386-linux since 8e0446df landed. See #24261 - - - - - dfd670a0 by Ben Bellick at 2023-12-24T10:10:31-05:00 Deprecate -ddump-json and introduce -fdiagnostics-as-json Addresses #19278 This commit deprecates the underspecified -ddump-json flag and introduces a newer, well-specified flag -fdiagnostics-as-json. Also included is a JSON schema as part of the documentation. The -ddump-json flag will be slated for removal shortly after this merge. - - - - - 609e6225 by Ben Bellick at 2023-12-24T10:10:31-05:00 Deprecate -ddump-json and introduce -fdiagnostics-as-json Addresses #19278 This commit deprecates the underspecified -ddump-json flag and introduces a newer, well-specified flag -fdiagnostics-as-json. Also included is a JSON schema as part of the documentation. The -ddump-json flag will be slated for removal shortly after this merge. - - - - - 865513b2 by Ömer Sinan Ağacan at 2023-12-24T10:11:13-05:00 Fix BNF in user manual 6.6.8.2: formal syntax for instance declarations - - - - - c247b6be by Zubin Duggal at 2023-12-25T16:01:23-05:00 docs: document permissibility of -XOverloadedLabels (#24249) Document the permissibility introduced by https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst - - - - - e5b7eb59 by Ömer Sinan Ağacan at 2023-12-25T16:02:03-05:00 Fix a code block syntax in user manual sec. 6.8.8.6 - - - - - 2db11c08 by Ben Gamari at 2023-12-29T15:35:48-05:00 genSym: Reimplement via CAS on 32-bit platforms Previously the remaining use of the C implementation on 32-bit platforms resulted in a subtle bug, #24261. This was due to the C object (which used the RTS's `atomic_inc64` macro) being compiled without `-threaded` yet later being used in a threaded compiler. Side-step this issue by using the pure Haskell `genSym` implementation on all platforms. This required implementing `fetchAddWord64Addr#` in terms of CAS on 64-bit platforms. - - - - - 19328a8c by Xiaoyan Ren at 2023-12-29T15:36:30-05:00 Do not color the diagnostic code in error messages (#24172) - - - - - 685b467c by Krzysztof Gogolewski at 2023-12-29T15:37:06-05:00 Enforce that bindings of implicit parameters are lifted Fixes #24298 - - - - - bc4d67b7 by Matthew Craven at 2023-12-31T06:15:42-05:00 StgToCmm: Detect some no-op case-continuations ...and generate no code for them. Fixes #24264. - - - - - 5b603139 by Krzysztof Gogolewski at 2023-12-31T06:16:18-05:00 Revert "testsuite: mark jspace as fragile on i386." This reverts commit 0038d052c8c80b4b430bb2aa1c66d5280be1aa95. The atomicity bug should be fixed by !11802. - - - - - d55216ad by Krzysztof Gogolewski at 2024-01-01T12:05:49-05:00 Refactor: store [[PrimRep]] rather than [Type] in STG StgConApp stored a list of types. This list was used exclusively during unarisation of unboxed sums (mkUbxSum). However, this is at a wrong level of abstraction: STG shouldn't be concerned with Haskell types, only PrimReps. Update the code to store a [[PrimRep]]. Also, there's no point in storing this list when we're not dealing with an unboxed sum. - - - - - 8b340bc7 by Ömer Sinan Ağacan at 2024-01-01T12:06:29-05:00 Kind signatures docs: mention that they're allowed in newtypes - - - - - 989bf8e5 by Zubin Duggal at 2024-01-03T20:08:47-05:00 ci: Ensure we use the correct bindist name for the test artifact when generating release ghcup metadata Fixes #24268 - - - - - 89299a89 by Krzysztof Gogolewski at 2024-01-03T20:09:23-05:00 Refactor: remove calls to typePrimRepArgs The function typePrimRepArgs is just a thin wrapper around typePrimRep, adding a VoidRep if the list is empty. However, in StgToByteCode, we were discarding that VoidRep anyway, so there's no point in calling it. - - - - - c7be0c68 by mmzk1526 at 2024-01-03T20:10:07-05:00 Use "-V" for alex version check for better backward compatibility Fixes #24302. In recent versions of alex, "-v" is used for "--verbose" instead of "-version". - - - - - 67dbcc0a by Krzysztof Gogolewski at 2024-01-05T02:07:18-05:00 Fix VoidRep handling in ghci debugger 'go' inside extractSubTerms was giving a bad result given a VoidRep, attempting to round towards the next multiple of 0. I don't understand much about the debugger but the code should be better than it was. Fixes #24306 - - - - - 90ea574e by Krzysztof Gogolewski at 2024-01-05T02:07:54-05:00 VoidRep-related refactor * In GHC.StgToByteCode, replace bcIdPrimId with idPrimRep, bcIdArgRep with idArgRep, atomPrimRep with stgArgRep1. All of them were duplicates. * In GHC.Stg.Unarise, we were converting a PrimRep to a Type and back to PrimRep. Remove the calls to primRepToType and typePrimRep1 which cancel out. * In GHC.STG.Lint, GHC.StgToCmm, GHC.Types.RepType we were filtering out VoidRep from the result of typePrimRep. But typePrimRep never returns VoidRep - remove the filtering. - - - - - eaf72479 by brian at 2024-01-06T23:03:09-05:00 Add unaligned Addr# primops Implements CLC proposal #154: https://github.com/haskell/core-libraries-committee/issues/154 * add unaligned addr primops * add tests * accept tests * add documentation * fix js primops * uncomment in access ops * use Word64 in tests * apply suggestions * remove extra file * move docs * remove random options * use setByteArray# primop * better naming * update base-exports test * add base-exports for other architectures - - - - - d471d445 by Krzysztof Gogolewski at 2024-01-06T23:03:47-05:00 Remove VoidRep from PrimRep, introduce PrimOrVoidRep This introduces data PrimOrVoidRep = VoidRep | NVRep PrimRep changes typePrimRep1 to return PrimOrVoidRep, and adds a new function typePrimRepU to be used when the argument is definitely non-void. Details in Note [VoidRep] in GHC.Types.RepType. Fixes #19520 - - - - - 48720a07 by Matthew Craven at 2024-01-08T18:57:36-05:00 Apply Note [Sensitivity to unique increment] to LargeRecord - - - - - 9e2e180f by Sebastian Graf at 2024-01-08T18:58:13-05:00 Debugging: Add diffUFM for convenient diffing between UniqFMs - - - - - 948f3e35 by Sebastian Graf at 2024-01-08T18:58:13-05:00 Rename Opt_D_dump_stranal to Opt_D_dump_dmdanal ... and Opt_D_dump_str_signatures to Opt_D_dump_dmd_signatures - - - - - 4e217e3e by Sebastian Graf at 2024-01-08T18:58:13-05:00 Deprecate -ddump-stranal and -ddump-str-signatures ... and suggest -ddump-dmdanal and -ddump-dmd-signatures instead - - - - - 6c613c90 by Sebastian Graf at 2024-01-08T18:58:13-05:00 Move testsuite/tests/stranal to testsuite/tests/dmdanal A separate commit so that the rename is obvious to Git(Lab) - - - - - c929f02b by Sebastian Graf at 2024-01-08T18:58:13-05:00 CoreSubst: Stricten `substBndr` and `cloneBndr` Doing so reduced allocations of `cloneBndr` by about 25%. ``` T9233(normal) ghc/alloc 672,488,656 663,083,216 -1.4% GOOD T9675(optasm) ghc/alloc 423,029,256 415,812,200 -1.7% geo. mean -0.1% minimum -1.7% maximum +0.1% ``` Metric Decrease: T9233 - - - - - e3ca78f3 by Krzysztof Gogolewski at 2024-01-10T17:35:59-05:00 Deprecate -Wsemigroup This warning was used to prepare for Semigroup becoming a superclass of Monoid, and for (<>) being exported from Prelude. This happened in GHC 8.4 in 8ae263ceb3566 and feac0a3bc69fd3. The leftover logic for (<>) has been removed in GHC 9.8, 4d29ecdfcc79. Now the warning does nothing at all and can be deprecated. - - - - - 08d14925 by amesgen at 2024-01-10T17:36:42-05:00 WASM metadata: use correct GHC version - - - - - 7a808419 by Xiaoyan Ren at 2024-01-10T17:37:24-05:00 Allow SCC declarations in TH (#24081) - - - - - 28827c51 by Xiaoyan Ren at 2024-01-10T17:37:24-05:00 Fix prettyprinting of SCC pragmas - - - - - ae9cc1a8 by Matthew Craven at 2024-01-10T17:38:01-05:00 Fix loopification in the presence of void arguments This also removes Note [Void arguments in self-recursive tail calls], which was just misleading. It's important to count void args both in the function's arity and at the call site. Fixes #24295. - - - - - b718b145 by Zubin Duggal at 2024-01-10T17:38:36-05:00 testsuite: Teach testsuite driver about c++ sources - - - - - 09cb57ad by Zubin Duggal at 2024-01-10T17:38:36-05:00 driver: Set -DPROFILING when compiling C++ sources with profiling Earlier, we used to pass all preprocessor flags to the c++ compiler. This meant that -DPROFILING was passed to the c++ compiler because it was a part of C++ flags However, this was incorrect and the behaviour was changed in 8ff3134ed4aa323b0199ad683f72165e51a59ab6. See #21291. But that commit exposed this bug where -DPROFILING was no longer being passed when compiling c++ sources. The fix is to explicitly include -DPROFILING in `opt_cxx` when profiling is enabled to ensure we pass the correct options for the way to both C and C++ compilers Fixes #24286 - - - - - 2cf9dd96 by Zubin Duggal at 2024-01-10T17:38:36-05:00 testsuite: rename objcpp -> objcxx To avoid confusion with C Pre Processsor - - - - - af6932d6 by Simon Peyton Jones at 2024-01-10T17:39:12-05:00 Make TYPE and CONSTRAINT not-apart Issue #24279 showed up a bug in the logic in GHC.Core.Unify.unify_ty which is supposed to make TYPE and CONSTRAINT be not-apart. Easily fixed. - - - - - 4a39b5ff by Zubin Duggal at 2024-01-10T17:39:48-05:00 ci: Fix typo in mk_ghcup_metadata.py There was a missing colon in the fix to #24268 in 989bf8e53c08eb22de716901b914b3607bc8dd08 - - - - - 13503451 by Zubin Duggal at 2024-01-10T17:40:24-05:00 release-ci: remove release-x86_64-linux-deb11-release+boot_nonmoving_gc job There is no reason to have this release build or distribute this variation. This configuration is for testing purposes only. - - - - - afca46a4 by Sebastian Graf at 2024-01-10T17:41:00-05:00 Parser: Add a Note detailing why we need happy's `error` to implement layout - - - - - eaf8a06d by Krzysztof Gogolewski at 2024-01-11T00:43:17+01:00 Turn -Wtype-equality-out-of-scope on by default Also remove -Wnoncanonical-{monoid,monad}-instances from -Wcompat, since they are enabled by default. Refresh wcompat-warnings/ test with new -Wcompat warnings. Part of #24267 Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - 42bee5aa by Sebastian Graf at 2024-01-12T21:16:21-05:00 Arity: Require called *exactly once* for eta exp with -fpedantic-bottoms (#24296) In #24296, we had a program in which we eta expanded away an error despite the presence of `-fpedantic-bottoms`. This was caused by turning called *at least once* lambdas into one-shot lambdas, while with `-fpedantic-bottoms` it is only sound to eta expand over lambdas that are called *exactly* once. An example can be found in `Note [Combining arity type with demand info]`. Fixes #24296. - - - - - 7e95f738 by Andreas Klebinger at 2024-01-12T21:16:57-05:00 Aarch64: Enable -mfma by default. Fixes #24311 - - - - - e43788d0 by Jason Shipman at 2024-01-14T12:47:38-05:00 Add more instances for Compose: Fractional, RealFrac, Floating, RealFloat CLC proposal #226 https://github.com/haskell/core-libraries-committee/issues/226 - - - - - ae6d8cd2 by Sebastian Graf at 2024-01-14T12:48:15-05:00 Pmc: COMPLETE pragmas associated with Family TyCons should apply to representation TyCons as well (#24326) Fixes #24326. - - - - - c5fc7304 by sheaf at 2024-01-15T14:15:29-05:00 Use lookupOccRn_maybe in TH.lookupName When looking up a value, we want to be able to find both variables and record fields. So we should not use the lookupSameOccRn_maybe function, as we can't know ahead of time which record field namespace a record field with the given textual name will belong to. Fixes #24293 - - - - - da908790 by Krzysztof Gogolewski at 2024-01-15T14:16:05-05:00 Make the build more strict on documentation errors * Detect undefined labels. This can be tested by adding :ref:`nonexistent` to a documentation rst file; attempting to build docs will fail. Fixed the undefined label in `9.8.1-notes.rst`. * Detect errors. While we have plenty of warnings, we can at least enforce that Sphinx does not report errors. Fixed the error in `required_type_arguments.rst`. Unrelated change: I have documented that the `-dlint` enables `-fcatch-nonexhaustive-cases`, as can be verified by checking `enableDLint`. - - - - - 5077416e by Javier Sagredo at 2024-01-16T15:40:06-05:00 Profiling: Adds an option to not start time profiling at startup Using the functionality provided by d89deeba47ce04a5198a71fa4cbc203fe2c90794, this patch creates a new rts flag `--no-automatic-time-samples` which disables the time profiling when starting a program. It is then expected that the user starts it whenever it is needed. Fixes #24337 - - - - - 5776008c by Matthew Pickering at 2024-01-16T15:40:42-05:00 eventlog: Fix off-by-one error in postIPE We were missing the extra_comma from the calculation of the size of the payload of postIPE. This was causing assertion failures when the event would overflow the buffer by one byte, as ensureRoomForVariable event would report there was enough space for `n` bytes but then we would write `n + 1` bytes into the buffer. Fixes #24287 - - - - - 66dc09b1 by Simon Peyton Jones at 2024-01-16T15:41:18-05:00 Improve SpecConstr (esp nofib/spectral/ansi) This MR makes three improvements to SpecConstr: see #24282 * It fixes an outright (and recently-introduced) bug in `betterPat`, which was wrongly forgetting to compare the lengths of the argument lists. * It enhances ConVal to inclue a boolean for work-free-ness, so that the envt can contain non-work-free constructor applications, so that we can do more: see Note [ConVal work-free-ness] * It rejigs `subsumePats` so that it doesn't reverse the list. This can make a difference because, when patterns overlap, we arbitrarily pick the first. There is no "right" way, but this retains the old pre-subsumePats behaviour, thereby "fixing" the regression in #24282. Nofib results +======================================== | spectral/ansi -21.14% | spectral/hartel/comp_lab_zift -0.12% | spectral/hartel/parstof +0.09% | spectral/last-piece -2.32% | spectral/multiplier +6.03% | spectral/para +0.60% | spectral/simple -0.26% +======================================== | geom mean -0.18% +---------------------------------------- The regression in `multiplier` is sad, but it simply replicates GHC's previous behaviour (e.g. GHC 9.6). - - - - - 65da79b3 by Matthew Pickering at 2024-01-16T15:41:54-05:00 hadrian: Reduce Cabal verbosity The comment claims that `simpleUserHooks` decrease verbosity, and it does, but only for the `postConf` phase. The other phases are too verbose with `-V`. At the moment > 5000 lines of the build log are devoted to output from `cabal copy`. So I take the simple approach and just decrease the verbosity level again. If the output of `postConf` is essential then it would be better to implement our own `UserHooks` which doesn't decrease the verbosity for `postConf`. Fixes #24338 - - - - - 16414d7d by Matthew Pickering at 2024-01-17T10:54:59-05:00 Stop retaining old ModGuts throughout subsequent simplifier phases Each phase of the simplifier typically rewrites the majority of ModGuts, so we want to be able to release the old ModGuts as soon as possible. `name_ppr_ctxt` lives throught the whole optimiser phase and it was retaining a reference to `ModGuts`, so we were failing to release the old `ModGuts` until the end of the phase (potentially doubling peak memory usage for that particular phase). This was discovered using eras profiling (#24332) Fixes #24328 - - - - - 7f0879e1 by Matthew Pickering at 2024-01-17T10:55:35-05:00 Update nofib submodule - - - - - 320454d3 by Cheng Shao at 2024-01-17T23:02:40+00:00 ci: bump ci-images for updated wasm image - - - - - 2eca52b4 by Cheng Shao at 2024-01-17T23:06:44+00:00 base: treat all FDs as "nonblocking" on wasm On posix platforms, when performing read/write on FDs, we check the nonblocking flag first. For FDs without this flag (e.g. stdout), we call fdReady() first, which in turn calls poll() to wait for I/O to be available on that FD. This is problematic for wasm32-wasi: although select()/poll() is supported via the poll_oneoff() wasi syscall, that syscall is rather heavyweight and runtime behavior differs in different wasi implementations. The issue is even worse when targeting browsers, given there's no satisfactory way to implement async I/O as a synchronous syscall, so existing JS polyfills for wasi often give up and simply return ENOSYS. Before we have a proper I/O manager that avoids poll_oneoff() for async I/O on wasm, this patch improves the status quo a lot by merely pretending all FDs are "nonblocking". Read/write on FDs will directly invoke read()/write(), which are much more reliably handled in existing wasi implementations, especially those in browsers. Fixes #23275 and the following test cases: T7773 isEOF001 openFile009 T4808 cgrun025 Approved by CLC proposal #234: https://github.com/haskell/core-libraries-committee/issues/234 - - - - - 83c6c710 by Andrew Lelechenko at 2024-01-18T05:21:49-05:00 base: clarify how to disable warnings about partiality of Data.List.{head,tail} - - - - - c4078f2f by Simon Peyton Jones at 2024-01-18T05:22:25-05:00 Fix four bug in handling of (forall cv. body_ty) These bugs are all described in #24335 It's not easy to provoke the bug, hence no test case. - - - - - 119586ea by Alexis King at 2024-01-19T00:08:00-05:00 Always refresh profiling CCSes after running pending initializers Fixes #24171. - - - - - 9718d970 by Oleg Grenrus at 2024-01-19T00:08:36-05:00 Set default-language: GHC2021 in ghc library Go through compiler/ sources, and remove all BangPatterns (and other GHC2021 enabled extensions in these files). - - - - - 3ef71669 by Matthew Pickering at 2024-01-19T21:55:16-05:00 testsuite: Remove unused have_library function Also remove the hence unused testsuite option `--test-package-db`. Fixes #24342 - - - - - 5b7fa20c by Jade at 2024-01-19T21:55:53-05:00 Fix Spelling in the compiler Tracking: #16591 - - - - - 09875f48 by Matthew Pickering at 2024-01-20T12:20:44-05:00 testsuite: Implement `isInTreeCompiler` in a more robust way Just a small refactoring to avoid redundantly specifying the same strings in two different places. - - - - - 0d12b987 by Jade at 2024-01-20T12:21:20-05:00 Change maintainer email from cvs-ghc at haskell.org to ghc-devs at haskell.org. Fixes #22142 - - - - - 1fa1c00c by Jade at 2024-01-23T19:17:03-05:00 Enhance Documentation of functions exported by Data.Function This patch aims to improve the documentation of functions exported in Data.Function Tracking: #17929 Fixes: #10065 - - - - - ab47a43d by Jade at 2024-01-23T19:17:39-05:00 Improve documentation of hGetLine. - Add explanation for whether a newline is returned - Add examples Fixes #14804 - - - - - dd4af0e5 by Cheng Shao at 2024-01-23T19:18:17-05:00 Fix genapply for cross-compilation by nuking fragile CPP logic This commit fixes incorrectly built genapply when cross compiling (#24347) by nuking all fragile CPP logic in it from the orbit. All target-specific info are now read from DerivedConstants.h at runtime, see added note for details. Also removes a legacy Makefile and adds haskell language server support for genapply. - - - - - 0cda2b8b by Cheng Shao at 2024-01-23T19:18:17-05:00 rts: enable wasm32 register mapping The wasm backend didn't properly make use of all Cmm global registers due to #24347. Now that it is fixed, this patch re-enables full register mapping for wasm32, and we can now generate smaller & faster wasm modules that doesn't always spill arguments onto the stack. Fixes #22460 #24152. - - - - - 0325a6e5 by Greg Steuck at 2024-01-24T01:29:44-05:00 Avoid utf8 in primops.txt.pp comments They don't make it through readFile' without explicitly setting the encoding. See https://gitlab.haskell.org/ghc/ghc/-/issues/17755 - - - - - 1aaf0bd8 by David Binder at 2024-01-24T01:30:20-05:00 Bump hpc and hpc-bin submodule Bump hpc to 0.7.0.1 Bump hpc-bin to commit d1780eb2 - - - - - e693a4e8 by Ben Gamari at 2024-01-24T01:30:56-05:00 testsuite: Ignore stderr in T8089 Otherwise spurious "Killed: 9" messages to stderr may cause the test to fail. Fixes #24361. - - - - - a40f4ab2 by sheaf at 2024-01-24T14:04:33-05:00 Fix FMA instruction on LLVM We were emitting the wrong instructions for fused multiply-add operations on LLVM: - the instruction name is "llvm.fma.f32" or "llvm.fma.f64", not "fmadd" - LLVM does not support other instructions such as "fmsub"; instead we implement these by flipping signs of some arguments - the instruction is an LLVM intrinsic, which requires handling it like a normal function call instead of a machine instruction Fixes #24223 - - - - - 69abc786 by Andrei Borzenkov at 2024-01-24T14:05:09-05:00 Add changelog entry for renaming tuples from (,,...,,) to Tuple<n> (24291) - - - - - 0ac8f385 by Cheng Shao at 2024-01-25T00:27:48-05:00 compiler: remove unused GHC.Linker module The GHC.Linker module is empty and unused, other than as a hack for the make build system. We can remove it now that make is long gone; the note is moved to GHC.Linker.Loader instead. - - - - - 699da01b by Hécate Moonlight at 2024-01-25T00:28:27-05:00 Clarification for newtype constructors when using `coerce` - - - - - b2d8cd85 by Matt Walker at 2024-01-26T09:50:08-05:00 Fix #24308 Add tests for semicolon separated where clauses - - - - - 0da490a1 by Ben Gamari at 2024-01-26T17:34:41-05:00 hsc2hs: Bump submodule - - - - - 3f442fd2 by Ben Gamari at 2024-01-26T17:34:41-05:00 Bump containers submodule to 0.7 - - - - - 82a1c656 by Sebastian Nagel at 2024-01-29T02:32:40-05:00 base: with{Binary}File{Blocking} only annotates own exceptions Fixes #20886 This ensures that inner, unrelated exceptions are not misleadingly annotated with the opened file. - - - - - 9294a086 by Andreas Klebinger at 2024-01-29T02:33:15-05:00 Fix fma warning when using llvm on aarch64. On aarch64 fma is always on so the +fma flag doesn't exist for that target. Hence no need to try and pass +fma to llvm. Fixes #24379 - - - - - ced2e731 by sheaf at 2024-01-29T17:27:12-05:00 No shadowing warnings for NoFieldSelector fields This commit ensures we don't emit shadowing warnings when a user shadows a field defined with NoFieldSelectors. Fixes #24381 - - - - - 8eeadfad by Patrick at 2024-01-29T17:27:51-05:00 Fix bug wrong span of nested_doc_comment #24378 close #24378 1. Update the start position of span in `nested_doc_comment` correctly. and hence the spans of identifiers of haddoc can be computed correctly. 2. add test `HaddockSpanIssueT24378`. - - - - - a557580f by Alexey Radkov at 2024-01-30T19:41:52-05:00 Fix irrelevant dodgy-foreign-imports warning on import f-pointers by value A test *сс018* is attached (not sure about the naming convention though). Note that without the fix, the test fails with the *dodgy-foreign-imports* warning passed to stderr. The warning disappears after the fix. GHC shouldn't warn on imports of natural function pointers from C by value (which is feasible with CApiFFI), such as ```haskell foreign import capi "cc018.h value f" f :: FunPtr (Int -> IO ()) ``` where ```c void (*f)(int); ``` See a related real-world use-case [here](https://gitlab.com/daniel-casanueva/pcre-light/-/merge_requests/17). There, GHC warns on import of C function pointer `pcre_free`. - - - - - ca99efaf by Alexey Radkov at 2024-01-30T19:41:53-05:00 Rename test cc018 -> T24034 - - - - - 88c38dd5 by Ben Gamari at 2024-01-30T19:42:28-05:00 rts/TraverseHeap.c: Ensure that PosixSource.h is included first - - - - - ca2e919e by Simon Peyton Jones at 2024-01-31T09:29:45+00:00 Make decomposeRuleLhs a bit more clever This fixes #24370 by making decomposeRuleLhs undertand dictionary /functions/ as well as plain /dictionaries/ - - - - - 94ce031d by Teo Camarasu at 2024-02-01T05:49:49-05:00 doc: Add -Dn flag to user guide Resolves #24394 - - - - - 31553b11 by Ben Gamari at 2024-02-01T12:21:29-05: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. - - - - - 0785cf81 by Ben Gamari at 2024-02-01T12:21:29-05:00 codeGen: Use relaxed accesses in ticky bumping - - - - - be423dda by Ben Gamari at 2024-02-01T12:21:29-05:00 base: use atomic write when updating timer manager - - - - - 8a310e35 by Ben Gamari at 2024-02-01T12:21:29-05:00 Use relaxed atomics to manipulate TSO status fields - - - - - d6809ee4 by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Add necessary barriers when manipulating TSO owner - - - - - 39e3ac5d by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Use `switch` to branch on why_blocked This is a semantics-preserving refactoring. - - - - - 515eb33d by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix synchronization on thread blocking state We now use a release barrier whenever we update a thread's blocking state. This required widening StgTSO.why_blocked as AArch64 does not support atomic writes on 16-bit values. - - - - - eb38812e by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS and only needs relaxed ordering. - - - - - 26c48dd6 by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix data race in threadStatus# - - - - - 6af43ab4 by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix data race in Interpreter's preemption check - - - - - 9502ad3c by Ben Gamari at 2024-02-01T12:21:29-05:00 rts/Messages: Fix data race - - - - - 60802db5 by Ben Gamari at 2024-02-01T12:21:30-05:00 rts/Prof: Fix data race - - - - - ef8ccef5 by Ben Gamari at 2024-02-01T12:21:30-05:00 rts: Use relaxed ordering on dirty/clean info tables updates When changing the dirty/clean state of a mutable object we needn't have any particular ordering. - - - - - 76fe2b75 by Ben Gamari at 2024-02-01T12:21:30-05:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - a6316eb4 by Ben Gamari at 2024-02-01T12:21:30-05:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 6bddfd3d by Ben Gamari at 2024-02-01T12:21:30-05:00 rts: Use fence rather than redundant load Previously we would use an atomic load to ensure acquire ordering. However, we now have `ACQUIRE_FENCE_ON`, which allows us to express this more directly. - - - - - 55c65dbc by Ben Gamari at 2024-02-01T12:21:30-05:00 rts: Fix data races in profiling timer - - - - - 856b5e75 by Ben Gamari at 2024-02-01T12:21:30-05:00 Add Note [C11 memory model] - - - - - 6534da24 by Cheng Shao at 2024-02-01T12:22:07-05:00 compiler: move generic cmm optimization logic in NCG to a standalone module This commit moves GHC.CmmToAsm.cmmToCmm to a standalone module, GHC.Cmm.GenericOpt. The main motivation is enabling this logic to be run in the wasm backend NCG code, which is defined in other modules that's imported by GHC.CmmToAsm, causing a cyclic dependency issue. - - - - - 87e34888 by Cheng Shao at 2024-02-01T12:22:07-05:00 compiler: explicitly disable PIC in wasm32 NCG This commit explicitly disables the ncgPIC flag for the wasm32 target. The wasm backend doesn't support PIC for the time being. - - - - - c6ce242e by Cheng Shao at 2024-02-01T12:22:07-05:00 compiler: enable generic cmm optimizations in wasm backend NCG This commit enables the generic cmm optimizations in other NCGs to be run in the wasm backend as well, followed by a late cmm control-flow optimization pass. The added optimizations do catch some corner cases not handled by the pre-NCG cmm pipeline and are useful in generating smaller CFGs. - - - - - 151dda4e by Andrei Borzenkov at 2024-02-01T12:22:43-05:00 Namespacing for WARNING/DEPRECATED pragmas (#24396) New syntax for WARNING and DEPRECATED pragmas was added, namely namespace specifierss: namespace_spec ::= 'type' | 'data' | {- empty -} warning ::= warning_category namespace_spec namelist strings deprecation ::= namespace_spec namelist strings A new data type was introduced to represent these namespace specifiers: data NamespaceSpecifier = NoSpecifier | TypeNamespaceSpecifier (EpToken "type") | DataNamespaceSpecifier (EpToken "data") Extension field XWarning now contains this NamespaceSpecifier. lookupBindGroupOcc function was changed: it now takes NamespaceSpecifier and checks that the namespace of the found names matches the passed flag. With this change {-# WARNING data D "..." #-} pragma will only affect value namespace and {-# WARNING type D "..." #-} will only affect type namespace. The same logic is applicable to DEPRECATED pragmas. Finding duplicated warnings inside rnSrcWarnDecls now takes into consideration NamespaceSpecifier flag to allow warnings with the same names that refer to different namespaces. - - - - - 38c3afb6 by Bryan Richter at 2024-02-01T12:23:19-05:00 CI: Disable the test-cabal-reinstall job Fixes #24363 - - - - - 27020458 by Matthew Craven at 2024-02-03T01:53:26-05:00 Bump bytestring submodule to something closer to 0.12.1 ...mostly so that 16d6b7e835ffdcf9b894e79f933dd52348dedd0c (which reworks unaligned writes in Builder) and the stuff in https://github.com/haskell/bytestring/pull/631 can see wider testing. The less-terrible code for unaligned writes used in Builder on hosts not known to be ulaigned-friendly also takes less effort for GHC to compile, resulting in a metric decrease for T21839c on some platforms. The metric increase on T21839r is caused by the unrelated commit 750dac33465e7b59100698a330b44de7049a345c. It perhaps warrants further analysis and discussion (see #23822) but is not critical. Metric Decrease: T21839c Metric Increase: T21839r - - - - - cdddeb0f by Rodrigo Mesquita at 2024-02-03T01:54:02-05:00 Work around autotools setting C11 standard in CC/CXX In autoconf >=2.70, C11 is set by default for $CC and $CXX via the -std=...11 flag. In this patch, we split the "-std" flag out of the $CC and $CXX variables, which we traditionally assume to be just the executable name/path, and move it to $CFLAGS/$CXXFLAGS instead. Fixes #24324 - - - - - 5ff7cc26 by Apoorv Ingle at 2024-02-03T13:14:46-06:00 Expand `do` blocks right before typechecking using the `HsExpansion` philosophy. - Fixes #18324 #20020 #23147 #22788 #15598 #22086 #21206 - The change is detailed in - Note [Expanding HsDo with HsExpansion] in `GHC.Tc.Gen.Do` - Note [Doing HsExpansion in the Renamer vs Typechecker] in `GHC.Rename.Expr` expains the rational of doing expansions in type checker as opposed to in the renamer - Adds new datatypes: - `GHC.Hs.Expr.XXExprGhcRn`: new datatype makes this expansion work easier 1. Expansion bits for Expressions, Statements and Patterns in (`ExpandedThingRn`) 2. `PopErrCtxt` a special GhcRn Phase only artifcat to pop the previous error message in the error context stack - `GHC.Basic.Origin` now tracks the reason for expansion in case of Generated This is useful for type checking cf. `GHC.Tc.Gen.Expr.tcExpr` case for `HsLam` - Kills `HsExpansion` and `HsExpanded` as we have inlined them in `XXExprGhcRn` and `XXExprGhcTc` - Ensures warnings such as 1. Pattern match checks 2. Failable patterns 3. non-() return in body statements are preserved - Kill `HsMatchCtxt` in favor of `TcMatchAltChecker` - Testcases: * T18324 T20020 T23147 T22788 T15598 T22086 * T23147b (error message check), * DoubleMatch (match inside a match for pmc check) * pattern-fails (check pattern match with non-refutable pattern, eg. newtype) * Simple-rec (rec statements inside do statment) * T22788 (code snippet from #22788) * DoExpanion1 (Error messages for body statments) * DoExpansion2 (Error messages for bind statements) * DoExpansion3 (Error messages for let statements) Also repoint haddock to the right submodule so that the test (haddockHypsrcTest) pass Metric Increase 'compile_time/bytes allocated': T9020 The testcase is a pathalogical example of a `do`-block with many statements that do nothing. Given that we are expanding the statements into function binds, we will have to bear a (small) 2% cost upfront in the compiler to unroll the statements. - - - - - 0df8ce27 by Vladislav Zavialov at 2024-02-04T03:55:14-05:00 Reduce parser allocations in allocateCommentsP In the most common case, the comment queue is empty, so we can skip the work of processing it. This reduces allocations by about 10% in the parsing001 test. Metric Decrease: MultiLayerModulesRecomp parsing001 - - - - - cfd68290 by Simon Peyton Jones at 2024-02-05T17:58:33-05:00 Stop dropping a case whose binder is demanded This MR fixes #24251. See Note [Case-to-let for strictly-used binders] in GHC.Core.Opt.Simplify.Iteration, plus #24251, for lots of discussion. Final Nofib changes over 0.1%: +----------------------------------------- | imaginary/digits-of-e2 -2.16% | imaginary/rfib -0.15% | real/fluid -0.10% | real/gamteb -1.47% | real/gg -0.20% | real/maillist +0.19% | real/pic -0.23% | real/scs -0.43% | shootout/n-body -0.41% | shootout/spectral-norm -0.12% +======================================== | geom mean -0.05% Pleasingly, overall executable size is down by just over 1%. Compile times (in perf/compiler) wobble around a bit +/- 0.5%, but the geometric mean is -0.1% which seems good. - - - - - e4d137bb by Simon Peyton Jones at 2024-02-05T17:58:33-05:00 Add Note [Bangs in Integer functions] ...to document the bangs in the functions in GHC.Num.Integer - - - - - ce90f12f by Andrei Borzenkov at 2024-02-05T17:59:09-05:00 Hide WARNING/DEPRECATED namespacing under -XExplicitNamespaces (#24396) - - - - - e2ea933f by Simon Peyton Jones at 2024-02-06T10:12:04-05:00 Refactoring in preparation for lazy skolemisation * Make HsMatchContext and HsStmtContext be parameterised over the function name itself, rather than over the pass. See [mc_fun field of FunRhs] in Language.Haskell.Syntax.Expr - Replace types HsMatchContext GhcPs --> HsMatchContextPs HsMatchContext GhcRn --> HsMatchContextRn HsMatchContext GhcTc --> HsMatchContextRn (sic! not Tc) HsStmtContext GhcRn --> HsStmtContextRn - Kill off convertHsMatchCtxt * Split GHC.Tc.Type.BasicTypes.TcSigInfo so that TcCompleteSig (describing a complete user-supplied signature) is its own data type. - Split TcIdSigInfo(CompleteSig, PartialSig) into TcCompleteSig(CSig) TcPartialSig(PSig) - Use TcCompleteSig in tcPolyCheck, CheckGen - Rename types and data constructors: TcIdSigInfo --> TcIdSig TcPatSynInfo(TPSI) --> TcPatSynSig(PatSig) - Shuffle around helper functions: tcSigInfoName (moved to GHC.Tc.Types.BasicTypes) completeSigPolyId_maybe (moved to GHC.Tc.Types.BasicTypes) tcIdSigName (inlined and removed) tcIdSigLoc (introduced) - Rearrange the pattern match in chooseInferredQuantifiers * Rename functions and types: tcMatchesCase --> tcCaseMatches tcMatchesFun --> tcFunBindMatches tcMatchLambda --> tcLambdaMatches tcPats --> tcMatchPats matchActualFunTysRho --> matchActualFunTys matchActualFunTySigma --> matchActualFunTy * Add HasDebugCallStack constraints to: mkBigCoreVarTupTy, mkBigCoreTupTy, boxTy, mkPiTy, mkPiTys, splitAppTys, splitTyConAppNoView_maybe * Use `penv` from the outer context in the inner loop of GHC.Tc.Gen.Pat.tcMultiple * Move tcMkVisFunTy, tcMkInvisFunTy, tcMkScaledFunTys down the file, factor out and export tcMkScaledFunTy. * Move isPatSigCtxt down the file. * Formatting and comments Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - f5d3e03c by Andrei Borzenkov at 2024-02-06T10:12:04-05:00 Lazy skolemisation for @a-binders (#17594) This patch is a preparation for @a-binders implementation. The main changes are: * Skolemisation is now prepared to deal with @binders. See Note [Skolemisation overview] in GHC.Tc.Utils.Unify. Most of the action is in - Utils.Unify.matchExpectedFunTys - Gen.Pat.tcMatchPats - Gen.Expr.tcPolyExprCheck - Gen.Binds.tcPolyCheck Some accompanying refactoring: * I found that funTyConAppTy_maybe was doing a lot of allocation, and rejigged userTypeError_maybe to avoid calling it. - - - - - 532993c8 by Zubin Duggal at 2024-02-06T10:12:41-05:00 driver: Really don't lose track of nodes when we fail to resolve cycles This fixes a bug in 8db8d2fd1c881032b1b360c032b6d9d072c11723, where we could lose track of acyclic components at the start of an unresolved cycle. We now ensure we never loose track of any of these components. As T24275 demonstrates, a "cyclic" SCC might not really be a true SCC: When viewed without boot files, we have a single SCC ``` [REC main:T24275B [main:T24275B {-# SOURCE #-}, main:T24275A {-# SOURCE #-}] main:T24275A [main:T24275A {-# SOURCE #-}]] ``` But with boot files this turns into ``` [NONREC main:T24275B {-# SOURCE #-} [], REC main:T24275B [main:T24275B {-# SOURCE #-}, main:T24275A {-# SOURCE #-}] main:T24275A {-# SOURCE #-} [main:T24275B], NONREC main:T24275A [main:T24275A {-# SOURCE #-}]] ``` Note that this is truly not an SCC, as no nodes are reachable from T24275B.hs-boot. However, we treat this entire group as a single "SCC" because it seems so when we analyse the graph without taking boot files into account. Indeed, we must return a single ResolvedCycle element in the BuildPlan for this as described in Note [Upsweep]. However, since after resolving this is not a true SCC anymore, `findCycle` fails to find a cycle and we have a sub-optimal error message as a result. To handle this, I extended `findCycle` to not assume its input is an SCC, and to try harder to find cycles in its input. Fixes #24275 - - - - - b35dd613 by Zubin Duggal at 2024-02-06T10:13:17-05:00 GHCi: Lookup breakpoint CCs in the correct module We need to look up breakpoint CCs in the module that the breakpoint points to, and not the current module. Fixes #24327 - - - - - b09e6958 by Zubin Duggal at 2024-02-06T10:13:17-05:00 testsuite: Add test for #24327 - - - - - 569b4c10 by doyougnu at 2024-02-07T03:06:26-05:00 ts: add compile_artifact, ignore_extension flag In b521354216f2821e00d75f088d74081d8b236810 the testsuite gained the capability to collect generic metrics. But this assumed that the test was not linking and producing artifacts and we only wanted to track object files, interface files, or build artifacts from the compiler build. However, some backends, such as the JS backend, produce artifacts when compiling, such as the jsexe directory which we want to track. This patch: - tweaks the testsuite to collect generic metrics on any build artifact in the test directory. - expands the exe_extension function to consider windows and adds the ignore_extension flag. - Modifies certain tests to add the ignore_extension flag. Tests such as heaprof002 expect a .ps file, but on windows without ignore_extensions the testsuite will look for foo.exe.ps. Hence the flag. - adds the size_hello_artifact test - - - - - 75a31379 by doyougnu at 2024-02-07T03:06:26-05:00 ts: add wasm_arch, heapprof002 wasm extension - - - - - c9731d6d by Rodrigo Mesquita at 2024-02-07T03:07:03-05:00 Synchronize bindist configure for #24324 In cdddeb0f1280b40cc194028bbaef36e127175c4c, we set up a workaround for #24324 in the in-tree configure script, but forgot to update the bindist configure script accordingly. This updates it. - - - - - d309f4e7 by Matthew Pickering at 2024-02-07T03:07:38-05:00 distrib/configure: Fix typo in CONF_GCC_LINKER_OPTS_STAGE2 variable Instead we were setting CONF_GCC_LINK_OPTS_STAGE2 which meant that we were missing passing `--target` when invoking the linker. Fixes #24414 - - - - - 77db84ab by Ben Gamari at 2024-02-08T00:35:22-05:00 llvmGen: Adapt to allow use of new pass manager. We now must use `-passes` in place of `-O<n>` due to #21936. Closes #21936. - - - - - 3c9ddf97 by Matthew Pickering at 2024-02-08T00:35:59-05:00 testsuite: Mark length001 as fragile on javascript Modifying the timeout multiplier is not a robust way to get this test to reliably fail. Therefore we mark it as fragile until/if javascript ever supports the stack limit. - - - - - 20b702b5 by Matthew Pickering at 2024-02-08T00:35:59-05:00 Javascript: Don't filter out rtsDeps list This logic appears to be incorrect as it would drop any dependency which was not in a direct dependency of the package being linked. In the ghc-internals split this started to cause errors because `ghc-internal` is not a direct dependency of most packages, and hence important symbols to keep which are hard coded into the js runtime were getting dropped. - - - - - 2df96366 by Ben Gamari at 2024-02-08T00:35:59-05:00 base: Cleanup whitespace in cbits - - - - - 44f6557a by Ben Gamari at 2024-02-08T00:35:59-05:00 Move `base` to `ghc-internal` Here we move a good deal of the implementation of `base` into a new package, `ghc-internal` such that it can be evolved independently from the user-visible interfaces of `base`. While we want to isolate implementation from interfaces, naturally, we would like to avoid turning `base` into a mere set of module re-exports. However, this is a non-trivial undertaking for a variety of reasons: * `base` contains numerous known-key and wired-in things, requiring corresponding changes in the compiler * `base` contains a significant amount of C code and corresponding autoconf logic, which is very fragile and difficult to break apart * `base` has numerous import cycles, which are currently dealt with via carefully balanced `hs-boot` files * We must not break existing users To accomplish this migration, I tried the following approaches: * [Split-GHC.Base]: Break apart the GHC.Base knot to allow incremental migration of modules into ghc-internal: this knot is simply too intertwined to be easily pulled apart, especially given the rather tricky import cycles that it contains) * [Move-Core]: Moving the "core" connected component of base (roughly 150 modules) into ghc-internal. While the Haskell side of this seems tractable, the C dependencies are very subtle to break apart. * [Move-Incrementally]: 1. Move all of base into ghc-internal 2. Examine the module structure and begin moving obvious modules (e.g. leaves of the import graph) back into base 3. Examine the modules remaining in ghc-internal, refactor as necessary to facilitate further moves 4. Go to (2) iterate until the cost/benefit of further moves is insufficient to justify continuing 5. Rename the modules moved into ghc-internal to ensure that they don't overlap with those in base 6. For each module moved into ghc-internal, add a shim module to base with the declarations which should be exposed and any requisite Haddocks (thus guaranteeing that base will be insulated from changes in the export lists of modules in ghc-internal Here I am using the [Move-Incrementally] approach, which is empirically the least painful of the unpleasant options above Bumps haddock submodule. Metric Decrease: haddock.Cabal haddock.base Metric Increase: MultiComponentModulesRecomp T16875 size_hello_artifact - - - - - e8fb2451 by Vladislav Zavialov at 2024-02-08T00:36:36-05:00 Haddock comments on infix constructors (#24221) Rewrite the `HasHaddock` instance for `ConDecl GhcPs` to account for infix constructors. This change fixes a Haddock regression (introduced in 19e80b9af252) that affected leading comments on infix data constructor declarations: -- | Docs for infix constructor | Int :* Bool The comment should be associated with the data constructor (:*), not with its left-hand side Int. - - - - - 9060d55b by Ben Gamari at 2024-02-08T00:37:13-05:00 Add os-string as a boot package Introduces `os-string` submodule. This will be necessary for `filepath-1.5`. - - - - - 9d65235a by Ben Gamari at 2024-02-08T00:37:13-05:00 gitignore: Ignore .hadrian_ghci_multi/ - - - - - d7ee12ea by Ben Gamari at 2024-02-08T00:37:13-05:00 hadrian: Set -this-package-name When constructing the GHC flags for a package Hadrian must take care to set `-this-package-name` in addition to `-this-unit-id`. This hasn't broken until now as we have not had any uses of qualified package imports. However, this will change with `filepath-1.5` and the corresponding `unix` bump, breaking `hadrian/multi-ghci`. - - - - - f2dffd2e by Ben Gamari at 2024-02-08T00:37:13-05:00 Bump filepath to 1.5.0.0 Required bumps of the following submodules: * `directory` * `filepath` * `haskeline` * `process` * `unix` * `hsc2hs` * `Win32` * `semaphore-compat` and the addition of `os-string` as a boot package. - - - - - ab533e71 by Matthew Pickering at 2024-02-08T00:37:50-05:00 Use specific clang assembler when compiling with -fllvm There are situations where LLVM will produce assembly which older gcc toolchains can't handle. For example on Deb10, it seems that LLVM >= 13 produces assembly which the default gcc doesn't support. A more robust solution in the long term is to require a specific LLVM compatible assembler when using -fllvm. Fixes #16354 - - - - - c32b6426 by Matthew Pickering at 2024-02-08T00:37:50-05:00 Update CI images with LLVM 15, ghc-9.6.4 and cabal-install-3.10.2.0 - - - - - 5fcd58be by Matthew Pickering at 2024-02-08T00:37:50-05:00 Update bootstrap plans for 9.4.8 and 9.6.4 - - - - - 707a32f5 by Matthew Pickering at 2024-02-08T00:37:50-05:00 Add alpine 3_18 release job This is mainly experimental and future proofing to enable a smooth transition to newer alpine releases once 3_12 is too old. - - - - - c37931b3 by John Ericson at 2024-02-08T06:39:05-05:00 Generate LLVM min/max bound policy via Hadrian Per #23966, I want the top-level configure to only generate configuration data for Hadrian, not do any "real" tasks on its own. This is part of that effort --- one less file generated by it. (It is still done with a `.in` file, so in a future world non-Hadrian also can easily create this file.) Split modules: - GHC.CmmToLlvm.Config - GHC.CmmToLlvm.Version - GHC.CmmToLlvm.Version.Bounds - GHC.CmmToLlvm.Version.Type This also means we can get rid of the silly `unused.h` introduced in !6803 / 7dfcab2f4bcb7206174ea48857df1883d05e97a2 as temporary kludge. Part of #23966 - - - - - 9f987235 by Apoorv Ingle at 2024-02-08T06:39:42-05:00 Enable mdo statements to use HsExpansions Fixes: #24411 Added test T24411 for regression - - - - - 762b2120 by Jade at 2024-02-08T15:17:15+00:00 Improve Monad, Functor & Applicative docs This patch aims to improve the documentation of Functor, Applicative, Monad and related symbols. The main goal is to make it more consistent and make accessible. See also: !10979 (closed) and !10985 (closed) Ticket #17929 Updates haddock submodule - - - - - 151770ca by Josh Meredith at 2024-02-10T14:28:15-05:00 JavaScript codegen: Use GHC's tag inference where JS backend-specific evaluation inference was previously used (#24309) - - - - - 2e880635 by Zubin Duggal at 2024-02-10T14:28:51-05:00 ci: Allow release-hackage-lint to fail Otherwise it blocks the ghcup metadata pipeline from running. - - - - - b0293f78 by Matthew Pickering at 2024-02-10T14:29:28-05:00 rts: eras profiling mode The eras profiling mode is useful for tracking the life-time of closures. When a closure is written, the current era is recorded in the profiling header. This records the era in which the closure was created. * Enable with -he * User mode: Use functions ghc-experimental module GHC.Profiling.Eras to modify the era * Automatically: --automatic-era-increment, increases the user era on major collections * The first era is era 1 * -he<era> can be used with other profiling modes to select a specific era If you just want to record the era but not to perform heap profiling you can use `-he --no-automatic-heap-samples`. https://well-typed.com/blog/2024/01/ghc-eras-profiling/ Fixes #24332 - - - - - be674a2c by Jade at 2024-02-10T14:30:04-05:00 Adjust error message for trailing whitespace in as-pattern. Fixes #22524 - - - - - 53ef83f9 by doyougnu at 2024-02-10T14:30:47-05:00 gitlab: js: add codeowners Fixes: - #24409 Follow on from: - #21078 and MR !9133 - When we added the JS backend this was forgotten. This patch adds the rightful codeowners. - - - - - 8bbe12f2 by Matthew Pickering at 2024-02-10T14:31:23-05:00 Bump CI images so that alpine3_18 image includes clang15 The only changes here are that clang15 is now installed on the alpine-3_18 image. - - - - - df9fd9f7 by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: handle stored null StablePtr Some Haskell codes unsafely cast StablePtr into ptr to compare against NULL. E.g. in direct-sqlite: if castStablePtrToPtr aggStPtr /= nullPtr then where `aggStPtr` is read (`peek`) from zeroed memory initially. We fix this by giving these StablePtr the same representation as other null pointers. It's safe because StablePtr at offset 0 is unused (for this exact reason). - - - - - 55346ede by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: disable MergeObjsMode test This isn't implemented for JS backend objects. - - - - - aef587f6 by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: add support for linking C sources Support linking C sources with JS output of the JavaScript backend. See the added documentation in the users guide. The implementation simply extends the JS linker to use the objects (.o) that were already produced by the emcc compiler and which were filtered out previously. I've also added some options to control the link with C functions (see the documentation about pragmas). With this change I've successfully compiled the direct-sqlite package which embeds the sqlite.c database code. Some wrappers are still required (see the documentation about wrappers) but everything generic enough to be reused for other libraries have been integrated into rts/js/mem.js. - - - - - b71b392f by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: avoid EMCC logging spurious failure emcc would sometime output messages like: cache:INFO: generating system asset: symbol_lists/424b44514e43d789148e69e4e7d1c7fdc0350b79.json... (this will be cached in "/emsdk/upstream/emscripten/cache/symbol_lists/424b44514e43d789148e69e4e7d1c7fdc0350b79.json" for subsequent builds) cache:INFO: - ok Cf https://github.com/emscripten-core/emscripten/issues/18607 This breaks our tests matching the stderr output. We avoid this by setting EMCC_LOGGING=0 - - - - - ff2c0cc9 by Simon Peyton Jones at 2024-02-12T12:19:17-05:00 Remove a dead comment Just remove an out of date block of commented-out code, and tidy up the relevant Notes. See #8317. - - - - - bedb4f0d by Teo Camarasu at 2024-02-12T18:50:33-05:00 nonmoving: Add support for heap profiling Add support for heap profiling while using the nonmoving collector. We greatly simply the implementation by disabling concurrent collection for GCs when heap profiling is enabled. This entails that the marked objects on the nonmoving heap are exactly the live objects. Note that we match the behaviour for live bytes accounting by taking the size of objects on the nonmoving heap to be that of the segment's block rather than the object itself. Resolves #22221 - - - - - d0d5acb5 by Teo Camarasu at 2024-02-12T18:51:09-05:00 doc: Add requires prof annotation to options that require it Resolves #24421 - - - - - 57bb8c92 by Cheng Shao at 2024-02-13T14:07:49-05:00 deriveConstants: add needed constants for wasm backend This commit adds needed constants to deriveConstants. They are used by RTS code in the wasm backend to support the JSFFI logic. - - - - - 615eb855 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms The pure Haskell implementation causes i386 regression in unrelated work that can be fixed by using C-based atomic increment, see added comment for details. - - - - - a9918891 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: allow JSFFI for wasm32 This commit allows the javascript calling convention to be used when the target platform is wasm32. - - - - - 8771a53b by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: allow boxed JSVal as a foreign type This commit allows the boxed JSVal type to be used as a foreign argument/result type. - - - - - 053c92b3 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: ensure ctors have the right priority on wasm32 This commit fixes the priorities of ctors generated by GHC codegen on wasm32, see the referred note for details. - - - - - b7942e0a by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: add JSFFI desugar logic for wasm32 This commit adds JSFFI desugar logic for the wasm backend. - - - - - 2c1dca76 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: add JavaScriptFFI to supported extension list on wasm32 This commit adds JavaScriptFFI as a supported extension when the target platform is wasm32. - - - - - 9ad0e2b4 by Cheng Shao at 2024-02-13T14:07:49-05:00 rts/ghc-internal: add JSFFI support logic for wasm32 This commit adds rts/ghc-internal logic to support the wasm backend's JSFFI functionality. - - - - - e9ebea66 by Cheng Shao at 2024-02-13T14:07:49-05:00 ghc-internal: fix threadDelay for wasm in browsers This commit fixes broken threadDelay for wasm when it runs in browsers, see added note for detailed explanation. - - - - - f85f3fdb by Cheng Shao at 2024-02-13T14:07:49-05:00 utils: add JSFFI utility code This commit adds JavaScript util code to utils to support the wasm backend's JSFFI functionality: - jsffi/post-link.mjs, a post-linker to process the linked wasm module and emit a small complement JavaScript ESM module to be used with it at runtime - jsffi/prelude.js, a tiny bit of prelude code as the JavaScript side of runtime logic - jsffi/test-runner.mjs, run the jsffi test cases Co-authored-by: amesgen <amesgen at amesgen.de> - - - - - 77e91500 by Cheng Shao at 2024-02-13T14:07:49-05:00 hadrian: distribute jsbits needed for wasm backend's JSFFI support The post-linker.mjs/prelude.js files are now distributed in the bindist libdir, so when using the wasm backend's JSFFI feature, the user wouldn't need to fetch them from a ghc checkout manually. - - - - - c47ba1c3 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: add opts.target_wrapper This commit adds opts.target_wrapper which allows overriding the target wrapper on a per test case basis when testing a cross target. This is used when testing the wasm backend's JSFFI functionality; the rest of the cases are tested using wasmtime, though the jsffi cases are tested using the node.js based test runner. - - - - - 8e048675 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: T22774 should work for wasm JSFFI T22774 works since the wasm backend now supports the JSFFI feature. - - - - - 1d07f9a6 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: add JSFFI test cases for wasm backend This commit adds a few test cases for the wasm backend's JSFFI functionality, as well as a simple README to instruct future contributors to add new test cases. - - - - - b8997080 by Cheng Shao at 2024-02-13T14:07:49-05:00 docs: add documentation for wasm backend JSFFI This commit adds changelog and user facing documentation for the wasm backend's JSFFI feature. - - - - - ffeb000d by David Binder at 2024-02-13T14:08:30-05:00 Add tests from libraries/process/tests and libraries/Win32/tests to GHC These tests were previously part of the libraries, which themselves are submodules of the GHC repository. This commit moves the tests directly to the GHC repository. - - - - - 5a932cf2 by David Binder at 2024-02-13T14:08:30-05:00 Do not execute win32 tests on non-windows runners - - - - - 500d8cb8 by Jade at 2024-02-13T14:09:07-05:00 prevent GHCi (and runghc) from suggesting other symbols when not finding main Fixes: #23996 - - - - - b19ec331 by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: update xxHash to v0.8.2 - - - - - 4a97bdb8 by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: use XXH3_64bits hash on all 64-bit platforms This commit enables XXH3_64bits hash to be used on all 64-bit platforms. Previously it was only enabled on x86_64, so platforms like aarch64 silently falls back to using XXH32 which degrades the hashing function quality. - - - - - ee01de7d by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: define XXH_INLINE_ALL This commit cleans up how we include the xxhash.h header and only define XXH_INLINE_ALL, which is sufficient to inline the xxHash functions without symbol collision. - - - - - 0e01e1db by Alan Zimmerman at 2024-02-14T02:13:22-05:00 EPA: Move EpAnn out of extension points Leaving a few that are too tricky, maybe some other time. Also - remove some unneeded helpers from Parser.y - reduce allocations with strictness annotations Updates haddock submodule Metric Decrease: parsing001 - - - - - de589554 by Andreas Klebinger at 2024-02-14T02:13:59-05:00 Fix ffi callbacks with >6 args and non-64bit args. Check for ptr/int arguments rather than 64-bit width arguments when counting integer register arguments. The old approach broke when we stopped using exclusively W64-sized types to represent sub-word sized integers. Fixes #24314 - - - - - 325b7613 by Ben Gamari at 2024-02-14T14:27:45-05:00 rts/EventLog: Place eliminate duplicate strlens Previously many of the `post*` implementations would first compute the length of the event's strings in order to determine the event length. Later we would then end up computing the length yet again in `postString`. Now we instead pass the string length to `postStringLen`, avoiding the repeated work. - - - - - 8aafa51c by Ben Gamari at 2024-02-14T14:27:46-05:00 rts/eventlog: Place upper bound on IPE string field lengths The strings in IPE events may be of unbounded length. Limit the lengths of these fields to 64k characters to ensure that we don't exceed the maximum event length. - - - - - 0e60d52c by Zubin Duggal at 2024-02-14T14:27:46-05:00 rts: drop unused postString function - - - - - d8d1333a by Cheng Shao at 2024-02-14T14:28:23-05:00 compiler/rts: fix wasm unreg regression This commit fixes two wasm unreg regressions caught by a nightly pipeline: - Unknown stg_scheduler_loopzh symbol when compiling scheduler.cmm - Invalid _hs_constructor(101) function name when handling ctor - - - - - 264a4fa9 by Owen Shepherd at 2024-02-15T09:41:06-05:00 feat: Add sortOn to Data.List.NonEmpty Adds `sortOn` to `Data.List.NonEmpty`, and adds comments describing when to use it, compared to `sortWith` or `sortBy . comparing`. The aim is to smooth out the API between `Data.List`, and `Data.List.NonEmpty`. This change has been discussed in the [clc issue](https://github.com/haskell/core-libraries-committee/issues/227). - - - - - b57200de by Fendor at 2024-02-15T09:41:47-05:00 Prefer RdrName over OccName for looking up locations in doc renaming step Looking up by OccName only does not take into account when functions are only imported in a qualified way. Fixes issue #24294 Bump haddock submodule to include regression test - - - - - 8ad02724 by Luite Stegeman at 2024-02-15T17:33:32-05:00 JS: add simple optimizer The simple optimizer reduces the size of the code generated by the JavaScript backend without the complexity and performance penalty of the optimizer in GHCJS. Also see #22736 Metric Decrease: libdir size_hello_artifact - - - - - 20769b36 by Matthew Pickering at 2024-02-15T17:34:07-05:00 base: Expose `--no-automatic-time-samples` in `GHC.RTS.Flags` API This patch builds on 5077416e12cf480fb2048928aa51fa4c8fc22cf1 and modifies the base API to reflect the new RTS flag. CLC proposal #243 - https://github.com/haskell/core-libraries-committee/issues/243 Fixes #24337 - - - - - 08031ada by Teo Camarasu at 2024-02-16T13:37:00-05:00 base: export System.Mem.performBlockingMajorGC The corresponding C function was introduced in ba73a807edbb444c49e0cf21ab2ce89226a77f2e. As part of #22264. Resolves #24228 The CLC proposal was disccused at: https://github.com/haskell/core-libraries-committee/issues/230 Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 1f534c2e by Florian Weimer at 2024-02-16T13:37:42-05:00 Fix C output for modern C initiative GCC 14 on aarch64 rejects the C code written by GHC with this kind of error: error: assignment to ‘ffi_arg’ {aka ‘long unsigned int’} from ‘HsPtr’ {aka ‘void *’} makes integer from pointer without a cast [-Wint-conversion] 68 | *(ffi_arg*)resp = cret; | ^ Add the correct cast. For more information on this see: https://fedoraproject.org/wiki/Changes/PortingToModernC Tested-by: Richard W.M. Jones <rjones at redhat.com> - - - - - 5d3f7862 by Matthew Craven at 2024-02-16T13:38:18-05:00 Bump bytestring submodule to 0.12.1.0 - - - - - 902ebcc2 by Ian-Woo Kim at 2024-02-17T06:01:01-05:00 Add missing BCO handling in scavenge_one. - - - - - 97d26206 by Sylvain Henry at 2024-02-17T06:01:44-05:00 Make cast between words and floats real primops (#24331) First step towards fixing #24331. Replace foreign prim imports with real primops. - - - - - a40e4781 by Sylvain Henry at 2024-02-17T06:01:44-05:00 Perf: add constant folding for bitcast between float and word (#24331) - - - - - 5fd2c00f by Sylvain Henry at 2024-02-17T06:01:44-05:00 Perf: replace stack checks with assertions in casting primops There are RESERVED_STACK_WORDS free words (currently 21) on the stack, so omit the checks. Suggested by Cheng Shao. - - - - - 401dfe7b by Sylvain Henry at 2024-02-17T06:01:44-05:00 Reexport primops from GHC.Float + add deprecation - - - - - 4ab48edb by Ben Gamari at 2024-02-17T06:02:21-05:00 rts/Hash: Don't iterate over chunks if we don't need to free data When freeing a `HashTable` there is no reason to walk over the hash list before freeing it if the user has not given us a `dataFreeFun`. Noticed while looking at #24410. - - - - - bd5a1f91 by Cheng Shao at 2024-02-17T06:03:00-05:00 compiler: add SEQ_CST fence support In addition to existing Acquire/Release fences, this commit adds SEQ_CST fence support to GHC, allowing Cmm code to explicitly emit a fence that enforces total memory ordering. The following logic is added: - The MO_SeqCstFence callish MachOp - The %prim fence_seq_cst() Cmm syntax and the SEQ_CST_FENCE macro in Cmm.h - MO_SeqCstFence lowering logic in every single GHC codegen backend - - - - - 2ce2a493 by Cheng Shao at 2024-02-17T06:03:38-05:00 testsuite: fix hs_try_putmvar002 for targets without pthread.h hs_try_putmvar002 includes pthread.h and doesn't work on targets without this header (e.g. wasm32). It doesn't need to include this header at all. This was previously unnoticed by wasm CI, though recent toolchain upgrade brought in upstream changes that completely removes pthread.h in the single-threaded wasm32-wasi sysroot, therefore we need to handle that change. - - - - - 1fb3974e by Cheng Shao at 2024-02-17T06:03:38-05:00 ci: bump ci-images to use updated wasm image This commit bumps our ci-images revision to use updated wasm image. - - - - - 56e3f097 by Andrew Lelechenko at 2024-02-17T06:04:13-05:00 Bump submodule text to 2.1.1 T17123 allocates less because of improvements to Data.Text.concat in 1a6a06a. Metric Decrease: T17123 - - - - - a7569495 by Cheng Shao at 2024-02-17T06:04:51-05:00 rts: remove redundant rCCCS initialization This commit removes the redundant logic of initializing each Capability's rCCCS to CCS_SYSTEM in initProfiling(). Before initProfiling() is called during RTS startup, each Capability's rCCCS has already been assigned CCS_SYSTEM when they're first initialized. - - - - - 7a0293cc by Ben Gamari at 2024-02-19T07:11:00-05:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 0dbd729e by Andrei Borzenkov at 2024-02-19T07:11:37-05:00 Parser, renamer, type checker for @a-binders (#17594) GHC Proposal 448 introduces binders for invisible type arguments (@a-binders) in various contexts. This patch implements @-binders in lambda patterns and function equations: {-# LANGUAGE TypeAbstractions #-} id1 :: a -> a id1 @t x = x :: t -- @t-binder on the LHS of a function equation higherRank :: (forall a. (Num a, Bounded a) => a -> a) -> (Int8, Int16) higherRank f = (f 42, f 42) ex :: (Int8, Int16) ex = higherRank (\ @a x -> maxBound @a - x ) -- @a-binder in a lambda pattern in an argument -- to a higher-order function Syntax ------ To represent those @-binders in the AST, the list of patterns in Match now uses ArgPat instead of Pat: data Match p body = Match { ... - m_pats :: [LPat p], + m_pats :: [LArgPat p], ... } + data ArgPat pass + = VisPat (XVisPat pass) (LPat pass) + | InvisPat (XInvisPat pass) (HsTyPat (NoGhcTc pass)) + | XArgPat !(XXArgPat pass) The VisPat constructor represents patterns for visible arguments, which include ordinary value-level arguments and required type arguments (neither is prefixed with a @), while InvisPat represents invisible type arguments (prefixed with a @). Parser ------ In the grammar (Parser.y), the lambda and lambda-cases productions of aexp non-terminal were updated to accept argpats instead of apats: aexp : ... - | '\\' apats '->' exp + | '\\' argpats '->' exp ... - | '\\' 'lcases' altslist(apats) + | '\\' 'lcases' altslist(argpats) ... + argpat : apat + | PREFIX_AT atype Function left-hand sides did not require any changes to the grammar, as they were already parsed with productions capable of parsing @-binders. Those binders were being rejected in post-processing (isFunLhs), and now we accept them. In Parser.PostProcess, patterns are constructed with the help of PatBuilder, which is used as an intermediate data structure when disambiguating between FunBind and PatBind. In this patch we define ArgPatBuilder to accompany PatBuilder. ArgPatBuilder is a short-lived data structure produced in isFunLhs and consumed in checkFunBind. Renamer ------- Renaming of @-binders builds upon prior work on type patterns, implemented in 2afbddb0f24, which guarantees proper scoping and shadowing behavior of bound type variables. This patch merely defines rnLArgPatsAndThen to process a mix of visible and invisible patterns: + rnLArgPatsAndThen :: NameMaker -> [LArgPat GhcPs] -> CpsRn [LArgPat GhcRn] + rnLArgPatsAndThen mk = mapM (wrapSrcSpanCps rnArgPatAndThen) where + rnArgPatAndThen (VisPat x p) = ... rnLPatAndThen ... + rnArgPatAndThen (InvisPat _ tp) = ... rnHsTyPat ... Common logic between rnArgPats and rnPats is factored out into the rn_pats_general helper. Type checker ------------ Type-checking of @-binders builds upon prior work on lazy skolemisation, implemented in f5d3e03c56f. This patch extends tcMatchPats to handle @-binders. Now it takes and returns a list of LArgPat rather than LPat: tcMatchPats :: ... - -> [LPat GhcRn] + -> [LArgPat GhcRn] ... - -> TcM ([LPat GhcTc], a) + -> TcM ([LArgPat GhcTc], a) Invisible binders in the Match are matched up with invisible (Specified) foralls in the type. This is done with a new clause in the `loop` worker of tcMatchPats: loop :: [LArgPat GhcRn] -> [ExpPatType] -> TcM ([LArgPat GhcTc], a) loop (L l apat : pats) (ExpForAllPatTy (Bndr tv vis) : pat_tys) ... -- NEW CLAUSE: | InvisPat _ tp <- apat, isSpecifiedForAllTyFlag vis = ... In addition to that, tcMatchPats no longer discards type patterns. This is done by filterOutErasedPats in the desugarer instead. x86_64-linux-deb10-validate+debug_info Metric Increase: MultiLayerModulesTH_OneShot - - - - - 486979b0 by Jade at 2024-02-19T07:12:13-05:00 Add specialized sconcat implementation for Data.Monoid.First and Data.Semigroup.First Approved CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/246 Fixes: #24346 - - - - - 17e309d2 by John Ericson at 2024-02-19T07:12:49-05:00 Fix reST in users guide It appears that aef587f65de642142c1dcba0335a301711aab951 wasn't valid syntax. - - - - - 35b0ad90 by Brandon Chinn at 2024-02-19T07:13:25-05:00 Fix searching for errors in sphinx build - - - - - 4696b966 by Cheng Shao at 2024-02-19T07:14:02-05:00 hadrian: fix wasm backend post linker script permissions The post-link.mjs script was incorrectly copied and installed as a regular data file without executable permission, this commit fixes it. - - - - - a6142e0c by Cheng Shao at 2024-02-19T07:14:40-05:00 testsuite: mark T23540 as fragile on i386 See #24449 for details. - - - - - 249caf0d by Matthew Craven at 2024-02-19T20:36:09-05:00 Add @since annotation to Data.Data.mkConstrTag - - - - - cdd939e7 by Jade at 2024-02-19T20:36:46-05:00 Enhance documentation of Data.Complex - - - - - d04f384f by Ben Gamari at 2024-02-21T04:59:23-05:00 hadrian/bindist: Ensure that phony rules are marked as such Otherwise make may not run the rule if file with the same name as the rule happens to exist. - - - - - efcbad2d by Ben Gamari at 2024-02-21T04:59:23-05:00 hadrian: Generate HSC2HS_EXTRAS variable in bindist installation We must generate the hsc2hs wrapper at bindist installation time since it must contain `--lflag` and `--cflag` arguments which depend upon the installation path. The solution here is to substitute these variables in the configure script (see mk/hsc2hs.in). This is then copied over a dummy wrapper in the install rules. Fixes #24050. - - - - - c540559c by Matthew Pickering at 2024-02-21T04:59:23-05:00 ci: Show --info for installed compiler - - - - - ab9281a2 by Matthew Pickering at 2024-02-21T04:59:23-05:00 configure: Correctly set --target flag for linker opts Previously we were trying to use the FP_CC_SUPPORTS_TARGET with 4 arguments, when it only takes 3 arguments. Instead we need to use the `FP_PROG_CC_LINKER_TARGET` function in order to set the linker flags. Actually fixes #24414 - - - - - 9460d504 by Rodrigo Mesquita at 2024-02-21T04:59:59-05:00 configure: Do not override existing linker flags in FP_LD_NO_FIXUP_CHAINS - - - - - 77629e76 by Andrei Borzenkov at 2024-02-21T05:00:35-05:00 Namespacing for fixity signatures (#14032) Namespace specifiers were added to syntax of fixity signatures: - sigdecl ::= infix prec ops | ... + sigdecl ::= infix prec namespace_spec ops | ... To preserve namespace during renaming MiniFixityEnv type now has separate FastStringEnv fields for names that should be on the term level and for name that should be on the type level. makeMiniFixityEnv function was changed to fill MiniFixityEnv in the right way: - signatures without namespace specifiers fill both fields - signatures with 'data' specifier fill data field only - signatures with 'type' specifier fill type field only Was added helper function lookupMiniFixityEnv that takes care about looking for a name in an appropriate namespace. Updates haddock submodule. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 84357d11 by Teo Camarasu at 2024-02-21T05:01:11-05:00 rts: only collect live words in nonmoving census when non-concurrent This avoids segfaults when the mutator modifies closures as we examine them. Resolves #24393 - - - - - 9ca56dd3 by Ian-Woo Kim at 2024-02-21T05:01:53-05:00 mutex wrap in refreshProfilingCCSs - - - - - 1387966a by Cheng Shao at 2024-02-21T05:02:32-05:00 rts: remove unused HAVE_C11_ATOMICS macro This commit removes the unused HAVE_C11_ATOMICS macro. We used to have a few places that have fallback paths when HAVE_C11_ATOMICS is not defined, but that is completely redundant, since the FP_CC_SUPPORTS__ATOMICS configure check will fail when the C compiler doesn't support C11 style atomics. There are also many places (e.g. in unreg backend, SMP.h, library cbits, etc) where we unconditionally use C11 style atomics anyway which work in even CentOS 7 (gcc 4.8), the oldest distro we test in our CI, so there's no value in keeping HAVE_C11_ATOMICS. - - - - - 0f40d68f by Andreas Klebinger at 2024-02-21T05:03:09-05:00 RTS: -Ds - make sure incall is non-zero before dereferencing it. Fixes #24445 - - - - - e5886de5 by Ben Gamari at 2024-02-21T05:03:44-05:00 rts/AdjustorPool: Use ExecPage abstraction This is just a minor cleanup I found while reviewing the implementation. - - - - - 09941666 by Adam Gundry at 2024-02-21T13:53:12+00:00 Define GHC2024 language edition (#24320) See https://github.com/ghc-proposals/ghc-proposals/pull/613. Also fixes #24343 and improves the documentation of language editions. Co-authored-by: Joachim Breitner <mail at joachim-breitner.de> - - - - - 5121a4ed by Ben Gamari at 2024-02-23T06:40:55-05:00 Allow docstrings after exports Here we extend the parser and AST to preserve docstrings following export items. We then extend Haddock to parse `@since` annotations in such docstrings, allowing changes in export structure to be properly documented. Bumps haddock submodule. - - - - - 0eb2265d by Hécate Moonlight at 2024-02-24T16:02:16-05:00 Improve the synopsis and description of base - - - - - 2e36f5d2 by Jade at 2024-02-24T16:02:51-05:00 Error Messages: Properly align cyclic module error Fixes: #24476 - - - - - bbfb051c by Ben Gamari at 2024-02-24T19:10:23-05:00 Allow docstrings after exports Here we extend the parser and AST to preserve docstrings following export items. We then extend Haddock to parse `@since` annotations in such docstrings, allowing changes in export structure to be properly documented. - - - - - d8d6ad8c by Ben Gamari at 2024-02-24T19:10:23-05:00 ghc-internal: Move modules into GHC.Internal.* namespace Bumps haddock submodule due to testsuite output changes. - - - - - a82af7cd by Ben Gamari at 2024-02-24T19:10:23-05:00 ghc-internal: Rewrite `@since ` to `@since base-` These will be incrementally moved to the export sites in `base` where possible. - - - - - ca3836e1 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Migrate Haddock `not-home` pragmas from `ghc-internal` This ensures that we do not use `base` stub modules as declarations' homes when not appropriate. - - - - - c8cf3e26 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Partially freeze exports of GHC.Base Sadly there are still a few module reexports. However, at least we have decoupled from the exports of `GHC.Internal.Base`. - - - - - 272573c6 by Ben Gamari at 2024-02-24T19:10:23-05:00 Move Haddock named chunks - - - - - 2d8a881d by Ben Gamari at 2024-02-24T19:10:23-05:00 Drop GHC.Internal.Data.Int - - - - - 55c4c385 by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler: Fix mention to `GHC....` modules in wasm desugaring Really, these references should be via known-key names anyways. I have fixed the proximate issue here but have opened #24472 to track the additional needed refactoring. - - - - - 64150911 by Ben Gamari at 2024-02-24T19:10:23-05:00 Accept performance shifts from ghc-internal restructure As expected, Haddock now does more work. Less expected is that some other testcases actually get faster, presumably due to less interface file loading. As well, the size_hello_artifact test regressed a bit when debug information is enabled due to debug information for the new stub symbols. Metric Decrease: T12227 T13056 Metric Increase: haddock.Cabal haddock.base MultiLayerModulesTH_OneShot size_hello_artifact - - - - - 317a915b by Ben Gamari at 2024-02-24T19:10:23-05:00 Expose GHC.Wasm.Prim from ghc-experimental Previously this was only exposed from `ghc-internal` which violates our agreement that users shall not rely on things exposed from that package. Fixes #24479. - - - - - 3bbd2bf2 by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler/tc: Small optimisation of evCallStack Don't lookupIds unless we actually need them. - - - - - 3e5c9e3c by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler/tc: Use toException instead of SomeException - - - - - 125714a6 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Factor out errorBelch This was useful when debugging - - - - - 3d6aae7c by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - 6900306e by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Move PrimMVar to GHC.Internal.MVar - - - - - 28f8a148 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Move prettyCallStack to GHC.Internal.Stack - - - - - 4892de47 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Explicit dependency to workaround #24436 Currently `ghc -M` fails to account for `.hs-boot` files correctly, leading to issues with cross-package one-shot builds failing. This currently manifests in `GHC.Exception` due to the boot file for `GHC.Internal.Stack`. Work around this by adding an explicit `import`, ensuring that `GHC.Internal.Stack` is built before `GHC.Exception`. See #24436. - - - - - 294c93a5 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Use displayException in top-level exception handler Happily this also allows us to eliminate a special case for Deadlock exceptions. Implements [CLC #198](https://github.com/haskell/core-libraries-committee/issues/198). - - - - - cf756a25 by Ben Gamari at 2024-02-24T22:11:53-05:00 rts: Fix symbol references in Wasm RTS - - - - - 4e4d47a0 by Jade at 2024-02-26T15:17:20-05:00 GHCi: Improve response to unloading, loading and reloading modules Fixes #13869 - - - - - f3de8a3c by Zubin Duggal at 2024-02-26T15:17:57-05:00 rel-eng/fetch-gitlab.py: Fix name of aarch64 alpine 3_18 release job - - - - - c71bfdff by Cheng Shao at 2024-02-26T15:18:35-05:00 hadrian/hie-bios: pass -j to hadrian This commit passes -j to hadrian in the hadrian/hie-bios scripts. When the user starts HLS in a fresh clone that has just been configured, it takes quite a while for hie-bios to pick up the ghc flags and start actual indexing, due to the fact that the hadrian build step defaulted to -j1, so -j speeds things up and improve HLS user experience in GHC. Also add -j flag to .ghcid to speed up ghcid, and sets the Windows build root to .hie-bios which also works and unifies with other platforms, the previous build root _hie-bios was missing from .gitignore anyway. - - - - - 50bfdb46 by Cheng Shao at 2024-02-26T15:18:35-05:00 ci: enable parallelism in hadrian/ghci scripts This commit enables parallelism when the hadrian/ghci scripts are called in CI. The time bottleneck is in the hadrian build step, but previously the build step wasn't parallelized. - - - - - 61a78231 by Felix Yan at 2024-02-26T15:19:14-05:00 m4: Correctly detect GCC version When calling as `cc`, GCC does not outputs lowercased "gcc" at least in 13.2.1 version here. ``` $ cc --version cc (GCC) 13.2.1 20230801 ... ``` This fails the check and outputs the confusing message: `configure: $CC is not gcc; assuming it's a reasonably new C compiler` This patch makes it check for upper-cased "GCC" too so that it works correctly: ``` checking version of gcc... 13.2.1 ``` - - - - - 001aa539 by Teo Camarasu at 2024-02-27T13:26:46-05:00 Fix formatting in whereFrom docstring Previously it used markdown syntax rather than Haddock syntax for code quotes - - - - - e8034d15 by Teo Camarasu at 2024-02-27T13:26:46-05:00 Move ClosureType type to ghc-internal - Use ClosureType for InfoProv.ipDesc. - Use ClosureType for CloneStack.closureType. - Now ghc-heap re-exports this type from ghc-internal. See the accompanying CLC proposal: https://github.com/haskell/core-libraries-committee/issues/210 Resolves #22600 - - - - - 3da0a551 by Matthew Craven at 2024-02-27T13:27:22-05:00 StgToJS: Simplify ExprInline constructor of ExprResult Its payload was used only for a small optimization in genAlts, avoiding a few assignments for programs of this form: case NormalDataCon arg1 arg2 of x { NormalDataCon x1 x2 -> ... ; } But when compiling with optimizations, this sort of code is generally eliminated by case-of-known-constructor in Core-to-Core. So it doesn't seem worth tracking and cleaning up again in StgToJS. - - - - - 61bc92cc by Cheng Shao at 2024-02-27T16:58:42-05:00 rts: add missing ccs_mutex guard to internal_dlopen See added comment for details. Closes #24423. - - - - - dd29d3b2 by doyougnu at 2024-02-27T16:59:23-05:00 cg: Remove GHC.Cmm.DataFlow.Collections In pursuit of #15560 and #17957 and generally removing redundancy. - - - - - d3a050d2 by Cheng Shao at 2024-02-27T17:00:00-05:00 utils: remove unused lndir from tree Ever since the removal of the make build system, the in tree lndir hasn't been actually built, so this patch removes it. - - - - - 74b24a9b by Teo Camarasu at 2024-02-28T16:32:58+00:00 rts: avoid checking bdescr of value outside of Haskell heap In nonmovingTidyWeaks we want to check if the key of a weak pointer lives in the non-moving heap. We do this by checking the flags of the block the key lives in. But we need to be careful with values that live outside the Haskell heap, since they will lack a block descriptor and looking for one may lead to a segfault. In this case we should just accept that it isn't on the non-moving heap. Resolves #24492 - - - - - b4cae4ec by Simon Peyton Jones at 2024-02-29T02:10:08-05:00 In mkDataConRep, ensure the in-scope set is right A small change that fixes #24489 - - - - - 3836a110 by Cheng Shao at 2024-02-29T21:25:45-05:00 testsuite: fix T23540 fragility on 32-bit platforms T23540 is fragile on 32-bit platforms. The root cause is usage of `getEvidenceTreesAtPoint`, which internally relies on `Name`'s `Ord` instance, which is indeterministic. The solution is adding a deterministic `Ord` instance for `EvidenceInfo` and sorting the evidence trees before pretty printing. Fixes #24449. - - - - - 960c8d47 by Teo Camarasu at 2024-02-29T21:26:20-05:00 Reduce AtomicModifyIORef increment count This test leads to a lot of contention when N>2 and becomes very slow. Let's reduce the amount of work we do to compensate. Resolves #24490 - - - - - 2e46c8ad by Matthew Pickering at 2024-03-01T05:48:06-05:00 hadrian: Improve parallelism in binary-dist-dir rule I noticed that the "docs" target was needed after the libraries and executables were built. We can improve the parallelism by needing everything at once so that documentation can be built immediately after a library is built for example. - - - - - cb6c11fe by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: Bump windows and freebsd boot compilers to 9.6.4 We have previously bumped the docker images to use 9.6.4, but neglected to bump the windows images until now. - - - - - 30f06996 by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: darwin: Update to 9.6.2 for boot compiler 9.6.4 is currently broken due to #24050 Also update to use LLVM-15 rather than LLVM-11, which is out of date. - - - - - d9d69e12 by Matthew Pickering at 2024-03-01T05:48:07-05:00 Bump minimum bootstrap version to 9.6 - - - - - 67ace1c5 by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: Enable more documentation building Here we enable documentation building on 1. Darwin: The sphinx toolchain was already installed so we enable html and manpages. 2. Rocky8: Full documentation (toolchain already installed) 3. Alpine: Full documetnation (toolchain already installed) 4. Windows: HTML and manpages (toolchain already installed) Fixes #24465 - - - - - 39583c39 by Matthew Pickering at 2024-03-01T05:48:42-05:00 ci: Bump ci-images to allow updated aarch64-alpine image with llvm15 and clang15 - - - - - d91d00fc by Torsten Schmits at 2024-03-01T15:01:50-05:00 Introduce ListTuplePuns extension This implements Proposal 0475, introducing the `ListTuplePuns` extension which is enabled by default. Disabling this extension makes it invalid to refer to list, tuple and sum type constructors by using built-in syntax like `[Int]`, `(Int, Int)`, `(# Int#, Int# #)` or `(# Int | Int #)`. Instead, this syntax exclusively denotes data constructors for use with `DataKinds`. The conventional way of referring to these data constructors by prefixing them with a single quote (`'(Int, Int)`) is now a parser error. Tuple declarations have been moved to `GHC.Tuple.Prim` and the `Solo` data constructor has been renamed to `MkSolo` (in a previous commit). Unboxed tuples and sums now have real source declarations in `GHC.Types`. Unit and solo types for tuples are now called `Unit`, `Unit#`, `Solo` and `Solo#`. Constraint tuples now have the unambiguous type constructors `CTuple<n>` as well as `CUnit` and `CSolo`, defined in `GHC.Classes` like before. A new parser construct has been added for the unboxed sum data constructor declarations. The type families `Tuple`, `Sum#` etc. that were intended to provide nicer syntax have been omitted from this change set due to inference problems, to be implemented at a later time. See the MR discussion for more info. Updates the submodule utils/haddock. Updates the cabal submodule due to new language extension. Metric Increase: haddock.base Metric Decrease: MultiLayerModulesTH_OneShot size_hello_artifact Proposal document: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst Merge request: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8820 Tracking ticket: https://gitlab.haskell.org/ghc/ghc/-/issues/21294 - - - - - bbdb6286 by Sylvain Henry at 2024-03-01T15:01:50-05:00 JS linker: filter unboxed tuples - - - - - dec6d8d3 by Arnaud Spiwack at 2024-03-01T15:02:30-05:00 Improve error messages coming from non-linear patterns This enriched the `CtOrigin` for non-linear patterns to include data of the pattern that created the constraint (which can be quite useful if it occurs nested in a pattern) as well as an explanation why the pattern is non-restricted in (at least in some cases). - - - - - 6612388e by Arnaud Spiwack at 2024-03-01T15:02:30-05:00 Adjust documentation of linear lets according to committee decision - - - - - 1c064ef1 by Cheng Shao at 2024-03-02T17:11:19-05:00 compiler: start deprecating cmmToRawCmmHook cmmToRawCmmHook was added 4 years ago in d561c8f6244f8280a2483e8753c38e39d34c1f01. Its only user is the Asterius project, which has been archived and deprecated in favor of the ghc wasm backend. This patch starts deprecating cmmToRawCmmHook by placing a DEPRECATED pragma, and actual removal shall happen in a future GHC major release if no issue to oppose the deprecation has been raised in the meantime. - - - - - 9b74845f by Andrew Lelechenko at 2024-03-02T17:11:55-05:00 Data.List.NonEmpty.unzip: use WARNING with category instead of DEPRECATED CLC proposal: https://github.com/haskell/core-libraries-committee/issues/258 - - - - - 61bb5ff6 by Finley McIlwaine at 2024-03-04T09:01:40-08:00 add -fprof-late-overloaded and -fprof-late-overloaded-calls * Refactor late cost centre insertion for extensibility * Add two more late cost centre insertion methods that add SCCs to overloaded top level bindings and call sites with dictionary arguments. * Some tests for the basic functionality of the new insertion methods Resolves: #24500 - - - - - 82ccb801 by Andreas Klebinger at 2024-03-04T19:59:14-05:00 x86-ncg: Fix fma codegen when arguments are globals Fix a bug in the x86 ncg where results would be wrong when the desired output register and one of the input registers were the same global. Also adds a tiny optimization to make use of the memory addressing support when convenient. Fixes #24496 - - - - - 18ad1077 by Matthew Pickering at 2024-03-05T14:22:31-05:00 rel_eng: Update hackage docs upload scripts This adds the upload of ghc-internal and ghc-experimental to our scripts which upload packages to hackage. - - - - - bf47c9ba by Matthew Pickering at 2024-03-05T14:22:31-05:00 docs: Remove stray module comment from GHC.Profiling.Eras - - - - - 37d9b340 by Matthew Pickering at 2024-03-05T14:22:31-05:00 Fix ghc-internal cabal file The file mentioned some artifacts relating to the base library. I have renamed these to the new ghc-internal variants. - - - - - 23f2a478 by Matthew Pickering at 2024-03-05T14:22:31-05:00 Fix haddock source links and hyperlinked source There were a few issues with the hackage links: 1. We were using the package id rather than the package name for the package links. This is fixed by now allowing the template to mention %pkg% or %pkgid% and substituing both appropiatly. 2. The `--haddock-base-url` flag is renamed to `--haddock-for-hackage` as the new base link works on a local or remote hackage server. 3. The "src" path including too much stuff, so cross-package source links were broken as the template was getting double expanded. Fixes #24086 - - - - - 2fa336a9 by Ben Gamari at 2024-03-05T14:23:07-05:00 filepath: Bump submodule to 1.5.2.0 - - - - - 31217944 by Ben Gamari at 2024-03-05T14:23:07-05:00 os-string: Bump submodule to 2.0.2 - - - - - 4074a3f2 by Matthew Pickering at 2024-03-05T21:44:35-05:00 base: Reflect new era profiling RTS flags in GHC.RTS.Flags * -he profiling mode * -he profiling selector * --automatic-era-increment CLC proposal #254 - https://github.com/haskell/core-libraries-committee/issues/254 - - - - - a8c0e31b by Sylvain Henry at 2024-03-05T21:45:14-05:00 JS: faster implementation for some numeric primitives (#23597) Use faster implementations for the following primitives in the JS backend by not using JavaScript's BigInt: - plusInt64 - minusInt64 - minusWord64 - timesWord64 - timesInt64 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 21e3f325 by Cheng Shao at 2024-03-05T21:45:52-05:00 rts: add -xr option to control two step allocator reserved space size This patch adds a -xr RTS option to control the size of virtual memory address space reserved by the two step allocator on a 64-bit platform, see added documentation for explanation. Closes #24498. - - - - - dedcf102 by Cheng Shao at 2024-03-06T13:39:04-05:00 rts: expose HeapAlloc.h as public header This commit exposes HeapAlloc.h as a public header. The intention is to expose HEAP_ALLOCED/HEAP_ALLOCED_GC, so they can be used in assertions in other public headers, and they may also be useful for user code. - - - - - d19441d7 by Cheng Shao at 2024-03-06T13:39:04-05:00 rts: assert pointer is indeed heap allocated in Bdescr() This commit adds an assertion to Bdescr() to assert the pointer is indeed heap allocated. This is useful to rule out RTS bugs that attempt to access non-existent block descriptor of a static closure, #24492 being one such example. - - - - - 9a656a04 by Ben Gamari at 2024-03-06T13:39:39-05:00 ghc-experimental: Add dummy dependencies to work around #23942 This is a temporary measure to improve CI reliability until a proper solution is developed. Works around #23942. - - - - - 1e84b924 by Simon Peyton Jones at 2024-03-06T13:39:39-05:00 Three compile perf improvements with deep nesting These were changes are all triggered by #24471. 1. Make GHC.Core.Opt.SetLevels.lvlMFE behave better when there are many free variables. See Note [Large free-variable sets]. 2. Make GHC.Core.Opt.Arity.floatIn a bit lazier in its Cost argument. This benefits the common case where the ArityType turns out to be nullary. See Note [Care with nested expressions] 3. Make GHC.CoreToStg.Prep.cpeArg behave for deeply-nested expressions. See Note [Eta expansion of arguments in CorePrep] wrinkle (EA2). Compile times go down by up to 4.5%, and much more in artificial cases. (Geo mean of compiler/perf changes is -0.4%.) Metric Decrease: CoOpt_Read T10421 T12425 - - - - - c4b13113 by Hécate Moonlight at 2024-03-06T13:40:17-05:00 Use "module" instead of "library" when applicable in base haddocks - - - - - 9cd9efb4 by Vladislav Zavialov at 2024-03-07T13:01:54+03:00 Rephrase error message to say "visible arguments" (#24318) * Main change: make the error message generated by mkFunTysMsg more accurate by changing "value arguments" to "visible arguments". * Refactor: define a new type synonym VisArity and use it instead of Arity in a few places. It might be the case that there other places in the compiler that should talk about visible arguments rather than value arguments, but I haven't tried to find them all, focusing only on the error message reported in the ticket. - - - - - d523a6a7 by Ben Gamari at 2024-03-07T19:40:45-05:00 Bump array submodule - - - - - 7e55003c by Ben Gamari at 2024-03-07T19:40:45-05:00 Bump stm submodule - - - - - 32d337ef by Ben Gamari at 2024-03-07T19:40:45-05:00 Introduce exception context Here we introduce the `ExceptionContext` type and `ExceptionAnnotation` class, allowing dynamically-typed user-defined annotations to be attached to exceptions. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/199 GHC Proposal: https://github.com/ghc-proposals/ghc-proposals/pull/330 - - - - - 39f3d922 by Ben Gamari at 2024-03-07T19:40:46-05:00 testsuite/interface-stability: Update documentation - - - - - fdea7ada by Ben Gamari at 2024-03-07T19:40:46-05:00 ghc-internal: comment formatting - - - - - 4fba42ef by Ben Gamari at 2024-03-07T19:40:46-05:00 compiler: Default and warn ExceptionContext constraints - - - - - 3886a205 by Ben Gamari at 2024-03-07T19:40:46-05:00 base: Introduce exception backtraces Here we introduce the `Backtraces` type and associated machinery for attaching these via `ExceptionContext`. These has a few compile-time regressions (`T15703` and `T9872d`) due to the additional dependencies in the exception machinery. As well, there is a surprisingly large regression in the `size_hello_artifact` test. This appears to be due to various `Integer` and `Read` bits now being reachable at link-time. I believe it should be possible to avoid this but I have accepted the change for now to get the feature merged. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/199 GHC Proposal: https://github.com/ghc-proposals/ghc-proposals/pull/330 Metric Increase: T15703 T9872d size_hello_artifact - - - - - 18c5409f by Ben Gamari at 2024-03-07T19:40:46-05:00 users guide: Release notes for exception backtrace work - - - - - f849c5fc by Ben Gamari at 2024-03-07T19:40:46-05:00 compiler: Don't show ExceptionContext of GhcExceptions Most GhcExceptions are user-facing errors and therefore the ExceptionContext has little value. Ideally we would enable it in the DEBUG compiler but I am leaving this for future work. - - - - - dc646e6f by Sylvain Henry at 2024-03-07T19:40:46-05:00 Disable T9930fail for the JS target (cf #19174) - - - - - bfc09760 by Alan Zimmerman at 2024-03-07T19:41:22-05:00 Update showAstData to honour blanking of AnnParen Also tweak rendering of SrcSpan to remove extra blank line. - - - - - 50454a29 by Ben Gamari at 2024-03-08T03:32:42-05:00 ghc-internal: Eliminate GHC.Internal.Data.Kind This was simply reexporting things from `ghc-prim`. Instead reexport these directly from `Data.Kind`. Also add build ordering dependency to work around #23942. - - - - - 38a4b6ab by Ben Gamari at 2024-03-08T03:33:18-05:00 rts: Fix SET_HDR initialization of retainer set This fixes a regression in retainer set profiling introduced by b0293f78cb6acf2540389e22bdda420d0ab874da. Prior to that commit the heap traversal word would be initialized by `SET_HDR` using `LDV_RECORD_CREATE`. However, the commit added a `doingLDVProfiling` check in `LDV_RECORD_CREATE`, meaning that this initialization no longer happened. Given that this initialization was awkwardly indirectly anyways, I have fixed this by explicitly initializating the heap traversal word to `NULL` in `SET_PROF_HDR`. This is equivalent to the previous behavior, but much more direct. Fixes #24513. - - - - - 2859a637 by Ben Gamari at 2024-03-08T18:26:47-05:00 base: Use strerror_r instead of strerror As noted by #24344, `strerror` is not necessarily thread-safe. Thankfully, POSIX.1-2001 has long offered `strerror_r`, which is safe to use. Fixes #24344. CLC discussion: https://github.com/haskell/core-libraries-committee/issues/249 - - - - - edb9bf77 by Jade at 2024-03-09T03:39:38-05:00 Error messages: Improve Error messages for Data constructors in type signatures. This patch improves the error messages from invalid type signatures by trying to guess what the user did and suggesting an appropriate fix. Partially fixes: #17879 - - - - - cfb197e3 by Patrick at 2024-03-09T03:40:15-05:00 HieAst: add module name #24493 The main purpose of this is to tuck the module name `xxx` in `module xxx where` into the hieAst. It should fix #24493. The following have been done: 1. Renamed and update the `tcg_doc_hdr :: Maybe (LHsDoc GhcRn)` to `tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName))` To store the located module name information. 2. update the `RenamedSource` and `RenamedStuff` with extra `Maybe (XRec GhcRn ModuleName)` located module name information. 3. add test `testsuite/tests/hiefile/should_compile/T24493.hs` to ensure the module name is added and update several relevent tests. 4. accompanied submodule haddoc test update MR in https://gitlab.haskell.org/ghc/haddock/-/merge_requests/53 - - - - - 2341d81e by Vaibhav Sagar at 2024-03-09T03:40:54-05:00 GHC.Utils.Binary: fix a couple of typos - - - - - 5580e1bd by Ben Gamari at 2024-03-09T03:41:30-05:00 rts: Drop .wasm suffix from .prof file names This replicates the behavior on Windows, where `Hi.exe` will produce profiling output named `Hi.prof` instead of `Hi.exe.prof`. While in the area I also fixed the extension-stripping logic, which incorrectly rewrote `Hi.exefoo` to `Hi.foo`. Closes #24515. - - - - - 259495ee by Cheng Shao at 2024-03-09T03:41:30-05:00 testsuite: drop exe extension from .hp & .prof filenames See #24515 for details. - - - - - c477a8d2 by Ben Gamari at 2024-03-09T03:42:05-05:00 rts/linker: Enable GOT support on all platforms There is nothing platform-dependent about our GOT implementation and GOT support is needed by `T24171` on i386. - - - - - 2e592857 by Vladislav Zavialov at 2024-03-09T03:42:41-05:00 Drop outdated comment on TcRnIllformedTypePattern This should have been done in 0f0c53a501b but I missed it. - - - - - c554b4da by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/CloneStack: Bounds check array write - - - - - 15c590a5 by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/CloneStack: Don't expose helper functions in header - - - - - e831ce31 by Ben Gamari at 2024-03-09T09:39:20-05:00 base: Move internals of GHC.InfoProv into GHC.InfoProv.Types Such that we can add new helpers into GHC.InfoProv.Types without breakage. - - - - - 6948e24d by Ben Gamari at 2024-03-09T09:39:20-05:00 rts: Lazily decode IPE tables Previously we would eagerly allocate `InfoTableEnt`s for each info table registered in the info table provenance map. However, this costs considerable memory and initialization time. Instead we now lazily decode these tables. This allows us to use one-third the memory *and* opens the door to taking advantage of sharing opportunities within a module. This required considerable reworking since lookupIPE now must be passed its result buffer. - - - - - 9204a04e by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/IPE: Don't expose helper in header - - - - - 308926ff by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/IPE: Share module_name within a Node This allows us to shave a 64-bit word off of the packed IPE entry size. - - - - - bebdea05 by Ben Gamari at 2024-03-09T09:39:20-05:00 IPE: Expose unit ID in InfoTableProv Here we add the unit ID to the info table provenance structure. - - - - - 6519c9ad by Ben Gamari at 2024-03-09T09:39:35-05:00 rts: Refactor GHC.Stack.CloneStack.decode Don't allocate a Ptr constructor per frame. - - - - - ed0b69dc by Ben Gamari at 2024-03-09T09:39:35-05:00 base: Do not expose whereFrom# from GHC.Exts - - - - - 2b1faea9 by Vladislav Zavialov at 2024-03-09T17:38:21-05:00 docs: Update info on TypeAbstractions * Mention TypeAbstractions in 9.10.1-notes.rst * Set the status to "Experimental". * Add a "Since: GHC 9.x" comment to each section. - - - - - f8b88918 by Ben Gamari at 2024-03-09T21:21:46-05:00 ci-images: Bump Alpine image to bootstrap with 9.8.2 - - - - - 705e6927 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Mark T24171 as fragile due to #24512 I will fix this but not in time for 9.10.1-alpha1 - - - - - c74196e1 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Mark linker_unload_native as fragile In particular this fails on platforms without `dlinfo`. I plan to address this but not before 9.10.1-alpha1. - - - - - f4d87f7a by Ben Gamari at 2024-03-09T21:21:46-05:00 configure: Bump version to 9.10 - - - - - 88df9a5f by Ben Gamari at 2024-03-09T21:21:46-05:00 Bump transformers submodule to 0.6.1.1 - - - - - 8176d5e8 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Increase ulimit for T18623 1 MByte was just too tight and failed intermittently on some platforms (e.g. CentOS 7). Bumping the limit to 8 MByte should provide sufficient headroom. Fixes #23139. - - - - - c74b38a3 by Ben Gamari at 2024-03-09T21:21:46-05:00 base: Bump version to 4.20.0.0 - - - - - b2937fc3 by Ben Gamari at 2024-03-09T21:21:46-05:00 ghc-internal: Set initial version at 9.1001.0 This provides PVP compliance while maintaining a clear correspondence between GHC releases and `ghc-internal` versions. - - - - - 4ae7d868 by Ben Gamari at 2024-03-09T21:21:46-05:00 ghc-prim: Bump version to 0.11.0 - - - - - 50798dc6 by Ben Gamari at 2024-03-09T21:21:46-05:00 template-haskell: Bump version to 2.22.0.0 - - - - - 8564f976 by Ben Gamari at 2024-03-09T21:21:46-05:00 base-exports: Accommodate spurious whitespace changes in 32-bit output It appears that this was - - - - - 9d4f0e98 by Ben Gamari at 2024-03-09T21:21:46-05:00 users-guide: Move exception backtrace relnotes to 9.10 This was previously mistakenly added to the GHC 9.8 release notes. - - - - - 145eae60 by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/rel_eng: Fix name of Rocky8 artifact - - - - - 39c2a630 by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/rel_eng: Fix path of generate_jobs_metadata - - - - - aed034de by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/upload: Rework recompression The old `combine` approach was quite fragile due to use of filename globbing. Moreover, it didn't parallelize well. This refactoring makes the goal more obvious, parallelizes better, and is more robust. - - - - - dc207d06 by Ben Gamari at 2024-03-10T08:56:08-04:00 configure: Bump GHC version to 9.11 Bumps haddock submodule. - - - - - 8b2513e8 by Ben Gamari at 2024-03-11T01:20:03-04:00 rts/linker: Don't unload code when profiling is enabled The heap census may contain references (e.g. `Counter.identity`) to static data which must be available when the census is reported at the end of execution. Fixes #24512. - - - - - 7810b4c3 by Ben Gamari at 2024-03-11T01:20:03-04:00 rts/linker: Don't unload native objects when dlinfo isn't available To do so is unsafe as we have no way of identifying references to symbols provided by the object. Fixes #24513. Fixes #23993. - - - - - 0590764c by Ben Gamari at 2024-03-11T01:20:39-04:00 rel_eng/upload: Purge both $rel_name/ and $ver/ This is necessary for prereleases, where GHCup accesses the release via `$ver/` - - - - - b85a4631 by Brandon Chinn at 2024-03-12T19:25:56-04:00 Remove duplicate code normalising slashes - - - - - c91946f9 by Brandon Chinn at 2024-03-12T19:25:56-04:00 Simplify regexes with raw strings - - - - - 1a5f53c6 by Brandon Chinn at 2024-03-12T19:25:57-04:00 Don't normalize backslashes in characters - - - - - 7ea971d3 by Andrei Borzenkov at 2024-03-12T19:26:32-04:00 Fix compiler crash caused by implicit RHS quantification in type synonyms (#24470) - - - - - 39f3ac3e by Cheng Shao at 2024-03-12T19:27:11-04:00 Revert "compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms" This reverts commit 615eb855416ce536e02ed935ecc5a6f25519ae16. It was originally intended to fix #24449, but it was merely sweeping the bug under the rug. 3836a110577b5c9343915fd96c1b2c64217e0082 has properly fixed the fragile test, and we no longer need the C version of genSym. Furthermore, the C implementation causes trouble when compiling with clang that targets i386 due to alignment warning and libatomic linking issue, so it makes sense to revert it. - - - - - e6bfb85c by Cheng Shao at 2024-03-12T19:27:11-04:00 compiler: fix out-of-bound memory access of genSym on 32-bit This commit fixes an unnoticed out-of-bound memory access of genSym on 32-bit. ghc_unique_inc is 32-bit sized/aligned on 32-bit platforms, but we mistakenly treat it as a Word64 pointer in genSym, and therefore will accidentally load 2 garbage higher bytes, or with a small but non-zero chance, overwrite something else in the data section depends on how the linker places the data segments. This regression was introduced in !11802 and fixed here. - - - - - 77171cd1 by Ben Orchard at 2024-03-14T09:00:40-04:00 Note mutability of array and address access primops Without an understanding of immutable vs. mutable memory, the index primop family have a potentially non-intuitive type signature: indexOffAddr :: Addr# -> Int# -> a readOffAddr :: Addr# -> Int# -> State# d -> (# State# d, a #) indexOffAddr# might seem like a free generality improvement, which it certainly is not! This change adds a brief note on mutability expectations for most index/read/write access primops. - - - - - 7da7f8f6 by Alan Zimmerman at 2024-03-14T09:01:15-04:00 EPA: Fix regression discarding comments in contexts Closes #24533 - - - - - 73be65ab by Fendor at 2024-03-19T01:42:53-04:00 Fix sharing of 'IfaceTyConInfo' during core to iface type translation During heap analysis, we noticed that during generation of 'mi_extra_decls' we have lots of duplicates for the instances: * `IfaceTyConInfo NotPromoted IfaceNormalTyCon` * `IfaceTyConInfo IsPromoted IfaceNormalTyCon` which should be shared instead of duplicated. This duplication increased the number of live bytes by around 200MB while loading the agda codebase into GHCi. These instances are created during `CoreToIface` translation, in particular `toIfaceTyCon`. The generated core looks like: toIfaceTyCon = \ tc_sjJw -> case $wtoIfaceTyCon tc_sjJw of { (# ww_sjJz, ww1_sjNL, ww2_sjNM #) -> IfaceTyCon ww_sjJz (IfaceTyConInfo ww1_sjNL ww2_sjNM) } whichs removes causes the sharing to work propery. Adding explicit sharing, with NOINLINE annotations, changes the core to: toIfaceTyCon = \ tc_sjJq -> case $wtoIfaceTyCon tc_sjJq of { (# ww_sjNB, ww1_sjNC #) -> IfaceTyCon ww_sjNB ww1_sjNC } which looks much more like sharing is happening. We confirmed via ghc-debug that all duplications were eliminated and the number of live bytes are noticeably reduced. - - - - - bd8209eb by Alan Zimmerman at 2024-03-19T01:43:28-04:00 EPA: Address more 9.10.1-alpha1 regressions from recent changes Closes #24533 Hopefully for good this time - - - - - 31bf85ee by Fendor at 2024-03-19T14:48:08-04:00 Escape multiple arguments in the settings file Uses responseFile syntax. The issue arises when GHC is installed on windows into a location that has a space, for example the user name is 'Fake User'. The $topdir will also contain a space, consequentially. When we resolve the top dir in the string `-I$topdir/mingw/include`, then `words` will turn this single argument into `-I/C/Users/Fake` and `User/.../mingw/include` which trips up the flag argument parser of various tools such as gcc or clang. We avoid this by escaping the $topdir before replacing it in `initSettngs`. Additionally, we allow to escape spaces and quotation marks for arguments in `settings` file. Add regression test case to count the number of options after variable expansion and argument escaping took place. Additionally, we check that escaped spaces and double quotation marks are correctly parsed. - - - - - f45f700e by Matthew Pickering at 2024-03-19T14:48:44-04:00 Read global package database from settings file Before this patch, the global package database was always assumed to be in libdir </> package.conf.d. This causes issues in GHC's build system because there are sometimes situations where the package database you need to use is not located in the same place as the settings file. * The stage1 compiler needs to use stage1 libraries, so we should set "Global Package DB" for the stage1 compiler to the stage1 package database. * Stage 2 cross compilers need to use stage2 libraries, so likewise, we should set the package database path to `_build/stage2/lib/` * The normal situation is where the stage2 compiler uses stage1 libraries. Then everything lines up. * When installing we have rearranged everything so that the settings file and package database line up properly, so then everything should continue to work as before. In this case we set the relative package db path to `package.conf.d`, so it resolves the same as before. * ghc-pkg needs to be modified as well to look in the settings file fo the package database rather than assuming the global package database location relative to the lib folder. * Cabal/cabal-install will work correctly because they query the global package database using `--print-global-package-db`. A reasonable question is why not generate the "right" settings files in the right places in GHC's build system. In order to do this you would need to engineer wrappers for all executables to point to a specific libdir. There are also situations where the same package db is used by two different compilers with two different settings files (think stage2 cross compiler and stage3 compiler). In short, this 10 line patch allows for some reasonable simplifications in Hadrian at very little cost to anything else. Fixes #24502 - - - - - 4c8f1794 by Matthew Pickering at 2024-03-19T14:48:44-04:00 hadrian: Remove stage1 testsuite wrappers logic Now instead of producing wrappers which pass the global package database argument to ghc and ghc-pkg, we write the location of the correct package database into the settings file so you can just use the intree compiler directly. - - - - - da0d8ba5 by Matthew Craven at 2024-03-19T14:49:20-04:00 Remove unused ghc-internal module "GHC.Internal.Constants" - - - - - b56d2761 by Matthew Craven at 2024-03-19T14:49:20-04:00 CorePrep: Rework lowering of BigNat# literals Don't use bigNatFromWord#, because that's terrible: * We shouldn't have to traverse a linked list at run-time to build a BigNat# literal. That's just silly! * The static List object we have to create is much larger than the actual BigNat#'s contents, bloating code size. * We have to read the corresponding interface file, which causes un-tracked implicit dependencies. (#23942) Instead, encode them into the appropriate platform-dependent sequence of bytes, and generate code that copies these bytes at run-time from an Addr# literal into a new ByteArray#. A ByteArray# literal would be the correct thing to generate, but these are not yet supported; see also #17747. Somewhat surprisingly, this change results in a slight reduction in compiler allocations, averaging around 0.5% on ghc's compiler performance tests, including when compiling programs that contain no bignum literals to begin with. The specific cause of this has not been investigated. Since this lowering no longer reads the interface file for GHC.Num.BigNat, the reasoning in Note [Depend on GHC.Num.Integer] is obsoleted. But the story of un-tracked built-in dependencies remains complex, and Note [Tracking dependencies on primitives] now exists to explain this complexity. Additionally, many empty imports have been modified to refer to this new note and comply with its guidance. Several empty imports necessary for other reasons have also been given brief explanations. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 349ea330 by Fendor at 2024-03-19T14:50:00-04:00 Eliminate thunk in 'IfaceTyCon' Heap analysis showed that `IfaceTyCon` retains a thunk to `IfaceTyConInfo`, defeating the sharing of the most common instances of `IfaceTyConInfo`. We make sure the indirection is removed by adding bang patterns to `IfaceTyCon`. Experimental results on the agda code base, where the `mi_extra_decls` were read from disk: Before this change, we observe around 8654045 instances of: `IfaceTyCon[Name,THUNK_1_0]` But these thunks almost exclusively point to a shared value! Forcing the thunk a little bit more, leads to `ghc-debug` reporting: `IfaceTyCon[Name:Name,IfaceTyConInfo]` and a noticeable reduction of live bytes (on agda ~10%). - - - - - 594bee0b by Krzysztof Gogolewski at 2024-03-19T14:50:36-04:00 Minor misc cleanups - GHC.HsToCore.Foreign.JavaScript: remove dropRuntimeRepArgs; boxed tuples don't take RuntimeRep args - GHC.HsToCore.Foreign.Call: avoid partial pattern matching - GHC.Stg.Unarise: strengthen the assertion; we can assert that non-rubbish literals are unary rather than just non-void - GHC.Tc.Gen.HsType: make sure the fsLit "literal" rule fires - users_guide/using-warnings.rst: remove -Wforall-identifier, now deprecated and does nothing - users_guide/using.rst: fix formatting - andy_cherry/test.T: remove expect_broken_for(23272...), 23272 is fixed The rest are simple cleanups. - - - - - cf55a54b by Ben Gamari at 2024-03-19T14:51:12-04:00 mk/relpath: Fix quoting Previously there were two instances in this script which lacked proper quoting. This resulted in `relpath` invocations in the binary distribution Makefile producing incorrect results on Windows, leading to confusing failures from `sed` and the production of empty package registrations. Fixes #24538. - - - - - 5ff88389 by Bryan Richter at 2024-03-19T14:51:48-04:00 testsuite: Disable T21336a on wasm - - - - - 60023351 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian/bindist: Eliminate extraneous `dirname` invocation Previously we would call `dirname` twice per installed library file. We now instead reuse this result. This helps appreciably on Windows, where processes are quite expensive. - - - - - 616ac300 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian: Package mingw toolchain in expected location This fixes #24525, a regression due to 41cbaf44a6ab5eb9fa676d65d32df8377898dc89. Specifically, GHC expects to find the mingw32 toolchain in the binary distribution root. However, after this patch it was packaged in the `lib/` directory. - - - - - de9daade by Ben Gamari at 2024-03-19T22:33:11-04:00 gitlab/rel_eng: More upload.sh tweaks - - - - - 1dfe12db by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_eng: Drop dead prepare_docs codepath - - - - - dd2d748b by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_env/recompress_all: unxz before recompressing Previously we would rather compress the xz *again*, before in addition compressing it with the desired scheme. Fixes #24545. - - - - - 9d936c57 by Ben Gamari at 2024-03-19T22:33:11-04:00 mk-ghcup-metadata: Fix directory of testsuite tarball As reported in #24546, the `dlTest` artifact should be extracted into the `testsuite` directory. - - - - - 6d398066 by Ben Gamari at 2024-03-19T22:33:11-04:00 ghcup-metadata: Don't populate dlOutput unless necessary ghcup can apparently infer the output name of an artifact from its URL. Consequently, we should only include the `dlOutput` field when it would differ from the filename of `dlUri`. Fixes #24547. - - - - - 576f8b7e by Zubin Duggal at 2024-03-19T22:33:46-04:00 Revert "Apply shellcheck suggestion to SUBST_TOOLDIR" This reverts commit c82770f57977a2b5add6e1378f234f8dd6153392. The shellcheck suggestion is spurious and results in SUBST_TOOLDIR being a no-op. `set` sets positional arguments for bash, but we want to set the variable given as the first autoconf argument. Fixes #24542 Metric decreases because the paths in the settings file are now shorter, so we allocate less when we read the settings file. ------------------------- Metric Decrease: T12425 T13035 T9198 ------------------------- - - - - - cdfe6e01 by Fendor at 2024-03-19T22:34:22-04:00 Compact serialisation of IfaceAppArgs In #24563, we identified that IfaceAppArgs serialisation tags each cons cell element with a discriminator byte. These bytes add up quickly, blowing up interface files considerably when '-fwrite-if-simplified-core' is enabled. We compact the serialisation by writing out the length of 'IfaceAppArgs', followed by serialising the elements directly without any discriminator byte. This improvement can decrease the size of some interface files by up to 35%. - - - - - 97a2bb1c by Simon Peyton Jones at 2024-03-20T17:11:29+00:00 Expand untyped splices in tcPolyExprCheck Fixes #24559 - - - - - 5f275176 by Alan Zimmerman at 2024-03-20T22:44:12-04:00 EPA: Clean up Exactprint helper functions a bit - Introduce a helper lens to compose on `EpAnn a` vs `a` versions - Rename some prime versions of functions back to non-prime They were renamed during the rework - - - - - da2a10ce by Vladislav Zavialov at 2024-03-20T22:44:48-04:00 Type operators in promoteOccName (#24570) Type operators differ from term operators in that they are lexically classified as (type) constructors, not as (type) variables. Prior to this change, promoteOccName did not account for this difference, causing a scoping issue that affected RequiredTypeArguments. type (!@#) = Bool f = idee (!@#) -- Not in scope: ‘!@#’ (BUG) Now we have a special case in promoteOccName to account for this. - - - - - 247fc0fa by Preetham Gujjula at 2024-03-21T10:19:18-04:00 docs: Remove mention of non-existent Ord instance for Complex The documentation for Data.Complex says that the Ord instance for Complex Float is deficient, but there is no Ord instance for Complex a. The Eq instance for Complex Float is similarly deficient, so we use that as an example instead. - - - - - 6fafc51e by Andrei Borzenkov at 2024-03-21T10:19:54-04:00 Fix TH handling in `pat_to_type_pat` function (#24571) There was missing case for `SplicePat` in `pat_to_type_at` function, hence patterns with splicing that checked against `forall->` doesn't work properly because they fall into the "illegal pattern" case. Code example that is now accepted: g :: forall a -> () g $([p| a |]) = () - - - - - 52072f8e by Sylvain Henry at 2024-03-21T21:01:59-04:00 Type-check default declarations before deriving clauses (#24566) See added Note and #24566. Default declarations must be type-checked before deriving clauses. - - - - - 7dfdf3d9 by Sylvain Henry at 2024-03-21T21:02:40-04:00 Lexer: small perf changes - Use unsafeChr because we know our values to be valid - Remove some unnecessary use of `ord` (return Word8 values directly) - - - - - 864922ef by Sylvain Henry at 2024-03-21T21:02:40-04:00 JS: fix some comments - - - - - 3e0b2b1f by Sebastian Graf at 2024-03-21T21:03:16-04:00 Simplifier: Re-do dependency analysis in abstractFloats (#24551) In #24551, we abstracted a string literal binding over a type variable, triggering a CoreLint error when that binding floated to top-level. The solution implemented in this patch fixes this by re-doing dependency analysis on a simplified recursive let binding that is about to be type abstracted, in order to find the minimal set of type variables to abstract over. See wrinkle (AB5) of Note [Floating and type abstraction] for more details. Fixes #24551 - - - - - 8a8ac65a by Matthew Craven at 2024-03-23T00:20:52-04:00 Improve toInteger @Word32 on 64-bit platforms On 64-bit platforms, every Word32 fits in an Int, so we can convert to Int# without having to perform the overflow check integerFromWord# uses internally. - - - - - 0c48f2b9 by Apoorv Ingle at 2024-03-23T00:21:28-04:00 Fix for #24552 (see testcase T24552) Fixes for a bug in desugaring pattern synonyms matches, introduced while working on on expanding `do`-blocks in #18324 The `matchWrapper` unecessarily (and incorrectly) filtered out the default wild patterns in a match. Now the wild pattern alternative is simply ignored by the pm check as its origin is `Generated`. The current code now matches the expected semantics according to the language spec. - - - - - b72705e9 by Simon Peyton Jones at 2024-03-23T00:22:04-04:00 Print more info about kinds in error messages This fixes #24553, where GHC unhelpfully said error: [GHC-83865] • Expected kind ‘* -> * -> *’, but ‘Foo’ has kind ‘* -> * -> *’ See Note [Showing invisible bits of types in error messages] - - - - - 8f7cfc7e by Tristan Cacqueray at 2024-03-23T00:22:44-04:00 docs: remove the don't use float hint This hint is outdated, ``Complex Float`` are now specialised, and the heap space suggestion needs more nuance so it should be explained in the unboxed/storable array documentation. - - - - - 5bd8ed53 by Andreas Klebinger at 2024-03-23T16:18:33-04:00 NCG: Fix a bug in jump shortcutting. When checking if a jump has more than one destination account for the possibility of some jumps not being representable by a BlockId. We do so by having isJumpishInstr return a `Maybe BlockId` where Nothing represents non-BlockId jump destinations. Fixes #24507 - - - - - 8d67f247 by Ben Gamari at 2024-03-23T16:19:09-04:00 docs: Drop old release notes, add for 9.12.1 - - - - - 7db8c992 by Cheng Shao at 2024-03-25T13:45:46-04:00 rts: fix clang compilation on aarch64 This patch fixes function prototypes in ARMOutlineAtomicsSymbols.h which causes "error: address argument to atomic operation must be a pointer to _Atomic type" when compiling with clang on aarch64. - - - - - 237194ce by Sylvain Henry at 2024-03-25T13:46:27-04:00 Lexer: fix imports for Alex 3.5.1 (#24583) - - - - - 810660b7 by Cheng Shao at 2024-03-25T22:19:16-04:00 libffi-tarballs: bump libffi-tarballs submodule to libffi 3.4.6 This commit bumps the libffi-tarballs submodule to libffi 3.4.6, which includes numerous upstream libffi fixes, especially https://github.com/libffi/libffi/issues/760. - - - - - d2ba41e8 by Alan Zimmerman at 2024-03-25T22:19:51-04:00 EPA: do not duplicate comments in signature RHS - - - - - 32a8103f by Rodrigo Mesquita at 2024-03-26T21:16:12-04:00 configure: Use LDFLAGS when trying linkers A user may configure `LDFLAGS` but not `LD`. When choosing a linker, we will prefer `ldd`, then `ld.gold`, then `ld.bfd` -- however, we have to check for a working linker. If either of these fail, we try the next in line. However, we were not considering the `$LDFLAGS` when checking if these linkers worked. So we would pick a linker that does not support the current $LDFLAGS and fail further down the line when we used that linker with those flags. Fixes #24565, where `LDFLAGS=-Wl,-z,pack-relative-relocs` is not supported by `ld.gold` but that was being picked still. - - - - - bf65a7c3 by Rodrigo Mesquita at 2024-03-26T21:16:48-04:00 bindist: Clean xattrs of bin and lib at configure time For issue #21506, we started cleaning the extended attributes of binaries and libraries from the bindist *after* they were installed to workaround notarisation (#17418), as part of `make install`. However, the `ghc-toolchain` binary that is now shipped with the bindist must be run at `./configure` time. Since we only cleaned the xattributes of the binaries and libs after they were installed, in some situations users would be unable to run `ghc-toolchain` from the bindist, failing at configure time (#24554). In this commit we move the xattr cleaning logic to the configure script. Fixes #24554 - - - - - cfeb70d3 by Rodrigo Mesquita at 2024-03-26T21:17:24-04:00 Revert "NCG: Fix a bug in jump shortcutting." This reverts commit 5bd8ed53dcefe10b72acb5729789e19ceb22df66. Fixes #24586 - - - - - 13223f6d by Serge S. Gulin at 2024-03-27T07:28:51-04:00 JS: `h$rts_isProfiled` is removed from `profiling` and left its version at `rts/js/config.js` - - - - - 0acfe391 by Alan Zimmerman at 2024-03-27T07:29:27-04:00 EPA: Do not extend declaration range for trailine zero len semi The lexer inserts virtual semicolons having zero width. Do not use them to extend the list span of items in a list. - - - - - cd0fb82f by Alan Zimmerman at 2024-03-27T19:33:08+00:00 EPA: Fix FamDecl range The span was incorrect if opt_datafam_kind_sig was empty - - - - - f8f384a8 by Ben Gamari at 2024-03-29T01:23:03-04:00 Fix type of _get_osfhandle foreign import Fixes #24601. - - - - - 00d3ecf0 by Alan Zimmerman at 2024-03-29T12:19:10+00:00 EPA: Extend StringLiteral range to include trailing commas This goes slightly against the exact printing philosophy where trailing decorations should be in an annotation, but the practicalities of adding it to the WarningTxt environment, and the problems caused by deviating do not make a more principles approach worthwhile. - - - - - efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - 37dafd12 by Simon Peyton Jones at 2024-04-02T22:08:07+01:00 Make newtype instances opaque I think this will help with #23109 Wibbles Allow SelCo for newtype classes Experimental change Wibble Furher wibbles Further improvments Further wibbles esp exprIsConLike Run classop rule first Newtype classops are small needs comments - - - - - 10 changed files: - .ghcid - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - .gitlab/generate-ci/gen_ci.hs - .gitlab/generate-ci/generate-job-metadata - .gitlab/generate-ci/generate-jobs - .gitlab/issue_templates/bug.md → .gitlab/issue_templates/default.md The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f18c7a4b763f05e0cb89fae754919c99f84763a2...37dafd12daa5f6f17b656c5b5494bce4fe7fe80d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f18c7a4b763f05e0cb89fae754919c99f84763a2...37dafd12daa5f6f17b656c5b5494bce4fe7fe80d You're receiving 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 Apr 2 22:47:33 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 02 Apr 2024 18:47:33 -0400 Subject: [Git][ghc/ghc][wip/spj-unf-size] 278 commits: Improve Monad, Functor & Applicative docs Message-ID: <660c8b0549030_f9da4045c649691b@gitlab.mail> Simon Peyton Jones pushed to branch wip/spj-unf-size at Glasgow Haskell Compiler / GHC Commits: 762b2120 by Jade at 2024-02-08T15:17:15+00:00 Improve Monad, Functor & Applicative docs This patch aims to improve the documentation of Functor, Applicative, Monad and related symbols. The main goal is to make it more consistent and make accessible. See also: !10979 (closed) and !10985 (closed) Ticket #17929 Updates haddock submodule - - - - - 151770ca by Josh Meredith at 2024-02-10T14:28:15-05:00 JavaScript codegen: Use GHC's tag inference where JS backend-specific evaluation inference was previously used (#24309) - - - - - 2e880635 by Zubin Duggal at 2024-02-10T14:28:51-05:00 ci: Allow release-hackage-lint to fail Otherwise it blocks the ghcup metadata pipeline from running. - - - - - b0293f78 by Matthew Pickering at 2024-02-10T14:29:28-05:00 rts: eras profiling mode The eras profiling mode is useful for tracking the life-time of closures. When a closure is written, the current era is recorded in the profiling header. This records the era in which the closure was created. * Enable with -he * User mode: Use functions ghc-experimental module GHC.Profiling.Eras to modify the era * Automatically: --automatic-era-increment, increases the user era on major collections * The first era is era 1 * -he<era> can be used with other profiling modes to select a specific era If you just want to record the era but not to perform heap profiling you can use `-he --no-automatic-heap-samples`. https://well-typed.com/blog/2024/01/ghc-eras-profiling/ Fixes #24332 - - - - - be674a2c by Jade at 2024-02-10T14:30:04-05:00 Adjust error message for trailing whitespace in as-pattern. Fixes #22524 - - - - - 53ef83f9 by doyougnu at 2024-02-10T14:30:47-05:00 gitlab: js: add codeowners Fixes: - #24409 Follow on from: - #21078 and MR !9133 - When we added the JS backend this was forgotten. This patch adds the rightful codeowners. - - - - - 8bbe12f2 by Matthew Pickering at 2024-02-10T14:31:23-05:00 Bump CI images so that alpine3_18 image includes clang15 The only changes here are that clang15 is now installed on the alpine-3_18 image. - - - - - df9fd9f7 by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: handle stored null StablePtr Some Haskell codes unsafely cast StablePtr into ptr to compare against NULL. E.g. in direct-sqlite: if castStablePtrToPtr aggStPtr /= nullPtr then where `aggStPtr` is read (`peek`) from zeroed memory initially. We fix this by giving these StablePtr the same representation as other null pointers. It's safe because StablePtr at offset 0 is unused (for this exact reason). - - - - - 55346ede by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: disable MergeObjsMode test This isn't implemented for JS backend objects. - - - - - aef587f6 by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: add support for linking C sources Support linking C sources with JS output of the JavaScript backend. See the added documentation in the users guide. The implementation simply extends the JS linker to use the objects (.o) that were already produced by the emcc compiler and which were filtered out previously. I've also added some options to control the link with C functions (see the documentation about pragmas). With this change I've successfully compiled the direct-sqlite package which embeds the sqlite.c database code. Some wrappers are still required (see the documentation about wrappers) but everything generic enough to be reused for other libraries have been integrated into rts/js/mem.js. - - - - - b71b392f by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: avoid EMCC logging spurious failure emcc would sometime output messages like: cache:INFO: generating system asset: symbol_lists/424b44514e43d789148e69e4e7d1c7fdc0350b79.json... (this will be cached in "/emsdk/upstream/emscripten/cache/symbol_lists/424b44514e43d789148e69e4e7d1c7fdc0350b79.json" for subsequent builds) cache:INFO: - ok Cf https://github.com/emscripten-core/emscripten/issues/18607 This breaks our tests matching the stderr output. We avoid this by setting EMCC_LOGGING=0 - - - - - ff2c0cc9 by Simon Peyton Jones at 2024-02-12T12:19:17-05:00 Remove a dead comment Just remove an out of date block of commented-out code, and tidy up the relevant Notes. See #8317. - - - - - bedb4f0d by Teo Camarasu at 2024-02-12T18:50:33-05:00 nonmoving: Add support for heap profiling Add support for heap profiling while using the nonmoving collector. We greatly simply the implementation by disabling concurrent collection for GCs when heap profiling is enabled. This entails that the marked objects on the nonmoving heap are exactly the live objects. Note that we match the behaviour for live bytes accounting by taking the size of objects on the nonmoving heap to be that of the segment's block rather than the object itself. Resolves #22221 - - - - - d0d5acb5 by Teo Camarasu at 2024-02-12T18:51:09-05:00 doc: Add requires prof annotation to options that require it Resolves #24421 - - - - - 57bb8c92 by Cheng Shao at 2024-02-13T14:07:49-05:00 deriveConstants: add needed constants for wasm backend This commit adds needed constants to deriveConstants. They are used by RTS code in the wasm backend to support the JSFFI logic. - - - - - 615eb855 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms The pure Haskell implementation causes i386 regression in unrelated work that can be fixed by using C-based atomic increment, see added comment for details. - - - - - a9918891 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: allow JSFFI for wasm32 This commit allows the javascript calling convention to be used when the target platform is wasm32. - - - - - 8771a53b by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: allow boxed JSVal as a foreign type This commit allows the boxed JSVal type to be used as a foreign argument/result type. - - - - - 053c92b3 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: ensure ctors have the right priority on wasm32 This commit fixes the priorities of ctors generated by GHC codegen on wasm32, see the referred note for details. - - - - - b7942e0a by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: add JSFFI desugar logic for wasm32 This commit adds JSFFI desugar logic for the wasm backend. - - - - - 2c1dca76 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: add JavaScriptFFI to supported extension list on wasm32 This commit adds JavaScriptFFI as a supported extension when the target platform is wasm32. - - - - - 9ad0e2b4 by Cheng Shao at 2024-02-13T14:07:49-05:00 rts/ghc-internal: add JSFFI support logic for wasm32 This commit adds rts/ghc-internal logic to support the wasm backend's JSFFI functionality. - - - - - e9ebea66 by Cheng Shao at 2024-02-13T14:07:49-05:00 ghc-internal: fix threadDelay for wasm in browsers This commit fixes broken threadDelay for wasm when it runs in browsers, see added note for detailed explanation. - - - - - f85f3fdb by Cheng Shao at 2024-02-13T14:07:49-05:00 utils: add JSFFI utility code This commit adds JavaScript util code to utils to support the wasm backend's JSFFI functionality: - jsffi/post-link.mjs, a post-linker to process the linked wasm module and emit a small complement JavaScript ESM module to be used with it at runtime - jsffi/prelude.js, a tiny bit of prelude code as the JavaScript side of runtime logic - jsffi/test-runner.mjs, run the jsffi test cases Co-authored-by: amesgen <amesgen at amesgen.de> - - - - - 77e91500 by Cheng Shao at 2024-02-13T14:07:49-05:00 hadrian: distribute jsbits needed for wasm backend's JSFFI support The post-linker.mjs/prelude.js files are now distributed in the bindist libdir, so when using the wasm backend's JSFFI feature, the user wouldn't need to fetch them from a ghc checkout manually. - - - - - c47ba1c3 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: add opts.target_wrapper This commit adds opts.target_wrapper which allows overriding the target wrapper on a per test case basis when testing a cross target. This is used when testing the wasm backend's JSFFI functionality; the rest of the cases are tested using wasmtime, though the jsffi cases are tested using the node.js based test runner. - - - - - 8e048675 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: T22774 should work for wasm JSFFI T22774 works since the wasm backend now supports the JSFFI feature. - - - - - 1d07f9a6 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: add JSFFI test cases for wasm backend This commit adds a few test cases for the wasm backend's JSFFI functionality, as well as a simple README to instruct future contributors to add new test cases. - - - - - b8997080 by Cheng Shao at 2024-02-13T14:07:49-05:00 docs: add documentation for wasm backend JSFFI This commit adds changelog and user facing documentation for the wasm backend's JSFFI feature. - - - - - ffeb000d by David Binder at 2024-02-13T14:08:30-05:00 Add tests from libraries/process/tests and libraries/Win32/tests to GHC These tests were previously part of the libraries, which themselves are submodules of the GHC repository. This commit moves the tests directly to the GHC repository. - - - - - 5a932cf2 by David Binder at 2024-02-13T14:08:30-05:00 Do not execute win32 tests on non-windows runners - - - - - 500d8cb8 by Jade at 2024-02-13T14:09:07-05:00 prevent GHCi (and runghc) from suggesting other symbols when not finding main Fixes: #23996 - - - - - b19ec331 by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: update xxHash to v0.8.2 - - - - - 4a97bdb8 by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: use XXH3_64bits hash on all 64-bit platforms This commit enables XXH3_64bits hash to be used on all 64-bit platforms. Previously it was only enabled on x86_64, so platforms like aarch64 silently falls back to using XXH32 which degrades the hashing function quality. - - - - - ee01de7d by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: define XXH_INLINE_ALL This commit cleans up how we include the xxhash.h header and only define XXH_INLINE_ALL, which is sufficient to inline the xxHash functions without symbol collision. - - - - - 0e01e1db by Alan Zimmerman at 2024-02-14T02:13:22-05:00 EPA: Move EpAnn out of extension points Leaving a few that are too tricky, maybe some other time. Also - remove some unneeded helpers from Parser.y - reduce allocations with strictness annotations Updates haddock submodule Metric Decrease: parsing001 - - - - - de589554 by Andreas Klebinger at 2024-02-14T02:13:59-05:00 Fix ffi callbacks with >6 args and non-64bit args. Check for ptr/int arguments rather than 64-bit width arguments when counting integer register arguments. The old approach broke when we stopped using exclusively W64-sized types to represent sub-word sized integers. Fixes #24314 - - - - - 325b7613 by Ben Gamari at 2024-02-14T14:27:45-05:00 rts/EventLog: Place eliminate duplicate strlens Previously many of the `post*` implementations would first compute the length of the event's strings in order to determine the event length. Later we would then end up computing the length yet again in `postString`. Now we instead pass the string length to `postStringLen`, avoiding the repeated work. - - - - - 8aafa51c by Ben Gamari at 2024-02-14T14:27:46-05:00 rts/eventlog: Place upper bound on IPE string field lengths The strings in IPE events may be of unbounded length. Limit the lengths of these fields to 64k characters to ensure that we don't exceed the maximum event length. - - - - - 0e60d52c by Zubin Duggal at 2024-02-14T14:27:46-05:00 rts: drop unused postString function - - - - - d8d1333a by Cheng Shao at 2024-02-14T14:28:23-05:00 compiler/rts: fix wasm unreg regression This commit fixes two wasm unreg regressions caught by a nightly pipeline: - Unknown stg_scheduler_loopzh symbol when compiling scheduler.cmm - Invalid _hs_constructor(101) function name when handling ctor - - - - - 264a4fa9 by Owen Shepherd at 2024-02-15T09:41:06-05:00 feat: Add sortOn to Data.List.NonEmpty Adds `sortOn` to `Data.List.NonEmpty`, and adds comments describing when to use it, compared to `sortWith` or `sortBy . comparing`. The aim is to smooth out the API between `Data.List`, and `Data.List.NonEmpty`. This change has been discussed in the [clc issue](https://github.com/haskell/core-libraries-committee/issues/227). - - - - - b57200de by Fendor at 2024-02-15T09:41:47-05:00 Prefer RdrName over OccName for looking up locations in doc renaming step Looking up by OccName only does not take into account when functions are only imported in a qualified way. Fixes issue #24294 Bump haddock submodule to include regression test - - - - - 8ad02724 by Luite Stegeman at 2024-02-15T17:33:32-05:00 JS: add simple optimizer The simple optimizer reduces the size of the code generated by the JavaScript backend without the complexity and performance penalty of the optimizer in GHCJS. Also see #22736 Metric Decrease: libdir size_hello_artifact - - - - - 20769b36 by Matthew Pickering at 2024-02-15T17:34:07-05:00 base: Expose `--no-automatic-time-samples` in `GHC.RTS.Flags` API This patch builds on 5077416e12cf480fb2048928aa51fa4c8fc22cf1 and modifies the base API to reflect the new RTS flag. CLC proposal #243 - https://github.com/haskell/core-libraries-committee/issues/243 Fixes #24337 - - - - - 08031ada by Teo Camarasu at 2024-02-16T13:37:00-05:00 base: export System.Mem.performBlockingMajorGC The corresponding C function was introduced in ba73a807edbb444c49e0cf21ab2ce89226a77f2e. As part of #22264. Resolves #24228 The CLC proposal was disccused at: https://github.com/haskell/core-libraries-committee/issues/230 Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 1f534c2e by Florian Weimer at 2024-02-16T13:37:42-05:00 Fix C output for modern C initiative GCC 14 on aarch64 rejects the C code written by GHC with this kind of error: error: assignment to ‘ffi_arg’ {aka ‘long unsigned int’} from ‘HsPtr’ {aka ‘void *’} makes integer from pointer without a cast [-Wint-conversion] 68 | *(ffi_arg*)resp = cret; | ^ Add the correct cast. For more information on this see: https://fedoraproject.org/wiki/Changes/PortingToModernC Tested-by: Richard W.M. Jones <rjones at redhat.com> - - - - - 5d3f7862 by Matthew Craven at 2024-02-16T13:38:18-05:00 Bump bytestring submodule to 0.12.1.0 - - - - - 902ebcc2 by Ian-Woo Kim at 2024-02-17T06:01:01-05:00 Add missing BCO handling in scavenge_one. - - - - - 97d26206 by Sylvain Henry at 2024-02-17T06:01:44-05:00 Make cast between words and floats real primops (#24331) First step towards fixing #24331. Replace foreign prim imports with real primops. - - - - - a40e4781 by Sylvain Henry at 2024-02-17T06:01:44-05:00 Perf: add constant folding for bitcast between float and word (#24331) - - - - - 5fd2c00f by Sylvain Henry at 2024-02-17T06:01:44-05:00 Perf: replace stack checks with assertions in casting primops There are RESERVED_STACK_WORDS free words (currently 21) on the stack, so omit the checks. Suggested by Cheng Shao. - - - - - 401dfe7b by Sylvain Henry at 2024-02-17T06:01:44-05:00 Reexport primops from GHC.Float + add deprecation - - - - - 4ab48edb by Ben Gamari at 2024-02-17T06:02:21-05:00 rts/Hash: Don't iterate over chunks if we don't need to free data When freeing a `HashTable` there is no reason to walk over the hash list before freeing it if the user has not given us a `dataFreeFun`. Noticed while looking at #24410. - - - - - bd5a1f91 by Cheng Shao at 2024-02-17T06:03:00-05:00 compiler: add SEQ_CST fence support In addition to existing Acquire/Release fences, this commit adds SEQ_CST fence support to GHC, allowing Cmm code to explicitly emit a fence that enforces total memory ordering. The following logic is added: - The MO_SeqCstFence callish MachOp - The %prim fence_seq_cst() Cmm syntax and the SEQ_CST_FENCE macro in Cmm.h - MO_SeqCstFence lowering logic in every single GHC codegen backend - - - - - 2ce2a493 by Cheng Shao at 2024-02-17T06:03:38-05:00 testsuite: fix hs_try_putmvar002 for targets without pthread.h hs_try_putmvar002 includes pthread.h and doesn't work on targets without this header (e.g. wasm32). It doesn't need to include this header at all. This was previously unnoticed by wasm CI, though recent toolchain upgrade brought in upstream changes that completely removes pthread.h in the single-threaded wasm32-wasi sysroot, therefore we need to handle that change. - - - - - 1fb3974e by Cheng Shao at 2024-02-17T06:03:38-05:00 ci: bump ci-images to use updated wasm image This commit bumps our ci-images revision to use updated wasm image. - - - - - 56e3f097 by Andrew Lelechenko at 2024-02-17T06:04:13-05:00 Bump submodule text to 2.1.1 T17123 allocates less because of improvements to Data.Text.concat in 1a6a06a. Metric Decrease: T17123 - - - - - a7569495 by Cheng Shao at 2024-02-17T06:04:51-05:00 rts: remove redundant rCCCS initialization This commit removes the redundant logic of initializing each Capability's rCCCS to CCS_SYSTEM in initProfiling(). Before initProfiling() is called during RTS startup, each Capability's rCCCS has already been assigned CCS_SYSTEM when they're first initialized. - - - - - 7a0293cc by Ben Gamari at 2024-02-19T07:11:00-05:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 0dbd729e by Andrei Borzenkov at 2024-02-19T07:11:37-05:00 Parser, renamer, type checker for @a-binders (#17594) GHC Proposal 448 introduces binders for invisible type arguments (@a-binders) in various contexts. This patch implements @-binders in lambda patterns and function equations: {-# LANGUAGE TypeAbstractions #-} id1 :: a -> a id1 @t x = x :: t -- @t-binder on the LHS of a function equation higherRank :: (forall a. (Num a, Bounded a) => a -> a) -> (Int8, Int16) higherRank f = (f 42, f 42) ex :: (Int8, Int16) ex = higherRank (\ @a x -> maxBound @a - x ) -- @a-binder in a lambda pattern in an argument -- to a higher-order function Syntax ------ To represent those @-binders in the AST, the list of patterns in Match now uses ArgPat instead of Pat: data Match p body = Match { ... - m_pats :: [LPat p], + m_pats :: [LArgPat p], ... } + data ArgPat pass + = VisPat (XVisPat pass) (LPat pass) + | InvisPat (XInvisPat pass) (HsTyPat (NoGhcTc pass)) + | XArgPat !(XXArgPat pass) The VisPat constructor represents patterns for visible arguments, which include ordinary value-level arguments and required type arguments (neither is prefixed with a @), while InvisPat represents invisible type arguments (prefixed with a @). Parser ------ In the grammar (Parser.y), the lambda and lambda-cases productions of aexp non-terminal were updated to accept argpats instead of apats: aexp : ... - | '\\' apats '->' exp + | '\\' argpats '->' exp ... - | '\\' 'lcases' altslist(apats) + | '\\' 'lcases' altslist(argpats) ... + argpat : apat + | PREFIX_AT atype Function left-hand sides did not require any changes to the grammar, as they were already parsed with productions capable of parsing @-binders. Those binders were being rejected in post-processing (isFunLhs), and now we accept them. In Parser.PostProcess, patterns are constructed with the help of PatBuilder, which is used as an intermediate data structure when disambiguating between FunBind and PatBind. In this patch we define ArgPatBuilder to accompany PatBuilder. ArgPatBuilder is a short-lived data structure produced in isFunLhs and consumed in checkFunBind. Renamer ------- Renaming of @-binders builds upon prior work on type patterns, implemented in 2afbddb0f24, which guarantees proper scoping and shadowing behavior of bound type variables. This patch merely defines rnLArgPatsAndThen to process a mix of visible and invisible patterns: + rnLArgPatsAndThen :: NameMaker -> [LArgPat GhcPs] -> CpsRn [LArgPat GhcRn] + rnLArgPatsAndThen mk = mapM (wrapSrcSpanCps rnArgPatAndThen) where + rnArgPatAndThen (VisPat x p) = ... rnLPatAndThen ... + rnArgPatAndThen (InvisPat _ tp) = ... rnHsTyPat ... Common logic between rnArgPats and rnPats is factored out into the rn_pats_general helper. Type checker ------------ Type-checking of @-binders builds upon prior work on lazy skolemisation, implemented in f5d3e03c56f. This patch extends tcMatchPats to handle @-binders. Now it takes and returns a list of LArgPat rather than LPat: tcMatchPats :: ... - -> [LPat GhcRn] + -> [LArgPat GhcRn] ... - -> TcM ([LPat GhcTc], a) + -> TcM ([LArgPat GhcTc], a) Invisible binders in the Match are matched up with invisible (Specified) foralls in the type. This is done with a new clause in the `loop` worker of tcMatchPats: loop :: [LArgPat GhcRn] -> [ExpPatType] -> TcM ([LArgPat GhcTc], a) loop (L l apat : pats) (ExpForAllPatTy (Bndr tv vis) : pat_tys) ... -- NEW CLAUSE: | InvisPat _ tp <- apat, isSpecifiedForAllTyFlag vis = ... In addition to that, tcMatchPats no longer discards type patterns. This is done by filterOutErasedPats in the desugarer instead. x86_64-linux-deb10-validate+debug_info Metric Increase: MultiLayerModulesTH_OneShot - - - - - 486979b0 by Jade at 2024-02-19T07:12:13-05:00 Add specialized sconcat implementation for Data.Monoid.First and Data.Semigroup.First Approved CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/246 Fixes: #24346 - - - - - 17e309d2 by John Ericson at 2024-02-19T07:12:49-05:00 Fix reST in users guide It appears that aef587f65de642142c1dcba0335a301711aab951 wasn't valid syntax. - - - - - 35b0ad90 by Brandon Chinn at 2024-02-19T07:13:25-05:00 Fix searching for errors in sphinx build - - - - - 4696b966 by Cheng Shao at 2024-02-19T07:14:02-05:00 hadrian: fix wasm backend post linker script permissions The post-link.mjs script was incorrectly copied and installed as a regular data file without executable permission, this commit fixes it. - - - - - a6142e0c by Cheng Shao at 2024-02-19T07:14:40-05:00 testsuite: mark T23540 as fragile on i386 See #24449 for details. - - - - - 249caf0d by Matthew Craven at 2024-02-19T20:36:09-05:00 Add @since annotation to Data.Data.mkConstrTag - - - - - cdd939e7 by Jade at 2024-02-19T20:36:46-05:00 Enhance documentation of Data.Complex - - - - - d04f384f by Ben Gamari at 2024-02-21T04:59:23-05:00 hadrian/bindist: Ensure that phony rules are marked as such Otherwise make may not run the rule if file with the same name as the rule happens to exist. - - - - - efcbad2d by Ben Gamari at 2024-02-21T04:59:23-05:00 hadrian: Generate HSC2HS_EXTRAS variable in bindist installation We must generate the hsc2hs wrapper at bindist installation time since it must contain `--lflag` and `--cflag` arguments which depend upon the installation path. The solution here is to substitute these variables in the configure script (see mk/hsc2hs.in). This is then copied over a dummy wrapper in the install rules. Fixes #24050. - - - - - c540559c by Matthew Pickering at 2024-02-21T04:59:23-05:00 ci: Show --info for installed compiler - - - - - ab9281a2 by Matthew Pickering at 2024-02-21T04:59:23-05:00 configure: Correctly set --target flag for linker opts Previously we were trying to use the FP_CC_SUPPORTS_TARGET with 4 arguments, when it only takes 3 arguments. Instead we need to use the `FP_PROG_CC_LINKER_TARGET` function in order to set the linker flags. Actually fixes #24414 - - - - - 9460d504 by Rodrigo Mesquita at 2024-02-21T04:59:59-05:00 configure: Do not override existing linker flags in FP_LD_NO_FIXUP_CHAINS - - - - - 77629e76 by Andrei Borzenkov at 2024-02-21T05:00:35-05:00 Namespacing for fixity signatures (#14032) Namespace specifiers were added to syntax of fixity signatures: - sigdecl ::= infix prec ops | ... + sigdecl ::= infix prec namespace_spec ops | ... To preserve namespace during renaming MiniFixityEnv type now has separate FastStringEnv fields for names that should be on the term level and for name that should be on the type level. makeMiniFixityEnv function was changed to fill MiniFixityEnv in the right way: - signatures without namespace specifiers fill both fields - signatures with 'data' specifier fill data field only - signatures with 'type' specifier fill type field only Was added helper function lookupMiniFixityEnv that takes care about looking for a name in an appropriate namespace. Updates haddock submodule. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 84357d11 by Teo Camarasu at 2024-02-21T05:01:11-05:00 rts: only collect live words in nonmoving census when non-concurrent This avoids segfaults when the mutator modifies closures as we examine them. Resolves #24393 - - - - - 9ca56dd3 by Ian-Woo Kim at 2024-02-21T05:01:53-05:00 mutex wrap in refreshProfilingCCSs - - - - - 1387966a by Cheng Shao at 2024-02-21T05:02:32-05:00 rts: remove unused HAVE_C11_ATOMICS macro This commit removes the unused HAVE_C11_ATOMICS macro. We used to have a few places that have fallback paths when HAVE_C11_ATOMICS is not defined, but that is completely redundant, since the FP_CC_SUPPORTS__ATOMICS configure check will fail when the C compiler doesn't support C11 style atomics. There are also many places (e.g. in unreg backend, SMP.h, library cbits, etc) where we unconditionally use C11 style atomics anyway which work in even CentOS 7 (gcc 4.8), the oldest distro we test in our CI, so there's no value in keeping HAVE_C11_ATOMICS. - - - - - 0f40d68f by Andreas Klebinger at 2024-02-21T05:03:09-05:00 RTS: -Ds - make sure incall is non-zero before dereferencing it. Fixes #24445 - - - - - e5886de5 by Ben Gamari at 2024-02-21T05:03:44-05:00 rts/AdjustorPool: Use ExecPage abstraction This is just a minor cleanup I found while reviewing the implementation. - - - - - 09941666 by Adam Gundry at 2024-02-21T13:53:12+00:00 Define GHC2024 language edition (#24320) See https://github.com/ghc-proposals/ghc-proposals/pull/613. Also fixes #24343 and improves the documentation of language editions. Co-authored-by: Joachim Breitner <mail at joachim-breitner.de> - - - - - 5121a4ed by Ben Gamari at 2024-02-23T06:40:55-05:00 Allow docstrings after exports Here we extend the parser and AST to preserve docstrings following export items. We then extend Haddock to parse `@since` annotations in such docstrings, allowing changes in export structure to be properly documented. Bumps haddock submodule. - - - - - 0eb2265d by Hécate Moonlight at 2024-02-24T16:02:16-05:00 Improve the synopsis and description of base - - - - - 2e36f5d2 by Jade at 2024-02-24T16:02:51-05:00 Error Messages: Properly align cyclic module error Fixes: #24476 - - - - - bbfb051c by Ben Gamari at 2024-02-24T19:10:23-05:00 Allow docstrings after exports Here we extend the parser and AST to preserve docstrings following export items. We then extend Haddock to parse `@since` annotations in such docstrings, allowing changes in export structure to be properly documented. - - - - - d8d6ad8c by Ben Gamari at 2024-02-24T19:10:23-05:00 ghc-internal: Move modules into GHC.Internal.* namespace Bumps haddock submodule due to testsuite output changes. - - - - - a82af7cd by Ben Gamari at 2024-02-24T19:10:23-05:00 ghc-internal: Rewrite `@since ` to `@since base-` These will be incrementally moved to the export sites in `base` where possible. - - - - - ca3836e1 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Migrate Haddock `not-home` pragmas from `ghc-internal` This ensures that we do not use `base` stub modules as declarations' homes when not appropriate. - - - - - c8cf3e26 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Partially freeze exports of GHC.Base Sadly there are still a few module reexports. However, at least we have decoupled from the exports of `GHC.Internal.Base`. - - - - - 272573c6 by Ben Gamari at 2024-02-24T19:10:23-05:00 Move Haddock named chunks - - - - - 2d8a881d by Ben Gamari at 2024-02-24T19:10:23-05:00 Drop GHC.Internal.Data.Int - - - - - 55c4c385 by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler: Fix mention to `GHC....` modules in wasm desugaring Really, these references should be via known-key names anyways. I have fixed the proximate issue here but have opened #24472 to track the additional needed refactoring. - - - - - 64150911 by Ben Gamari at 2024-02-24T19:10:23-05:00 Accept performance shifts from ghc-internal restructure As expected, Haddock now does more work. Less expected is that some other testcases actually get faster, presumably due to less interface file loading. As well, the size_hello_artifact test regressed a bit when debug information is enabled due to debug information for the new stub symbols. Metric Decrease: T12227 T13056 Metric Increase: haddock.Cabal haddock.base MultiLayerModulesTH_OneShot size_hello_artifact - - - - - 317a915b by Ben Gamari at 2024-02-24T19:10:23-05:00 Expose GHC.Wasm.Prim from ghc-experimental Previously this was only exposed from `ghc-internal` which violates our agreement that users shall not rely on things exposed from that package. Fixes #24479. - - - - - 3bbd2bf2 by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler/tc: Small optimisation of evCallStack Don't lookupIds unless we actually need them. - - - - - 3e5c9e3c by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler/tc: Use toException instead of SomeException - - - - - 125714a6 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Factor out errorBelch This was useful when debugging - - - - - 3d6aae7c by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - 6900306e by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Move PrimMVar to GHC.Internal.MVar - - - - - 28f8a148 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Move prettyCallStack to GHC.Internal.Stack - - - - - 4892de47 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Explicit dependency to workaround #24436 Currently `ghc -M` fails to account for `.hs-boot` files correctly, leading to issues with cross-package one-shot builds failing. This currently manifests in `GHC.Exception` due to the boot file for `GHC.Internal.Stack`. Work around this by adding an explicit `import`, ensuring that `GHC.Internal.Stack` is built before `GHC.Exception`. See #24436. - - - - - 294c93a5 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Use displayException in top-level exception handler Happily this also allows us to eliminate a special case for Deadlock exceptions. Implements [CLC #198](https://github.com/haskell/core-libraries-committee/issues/198). - - - - - cf756a25 by Ben Gamari at 2024-02-24T22:11:53-05:00 rts: Fix symbol references in Wasm RTS - - - - - 4e4d47a0 by Jade at 2024-02-26T15:17:20-05:00 GHCi: Improve response to unloading, loading and reloading modules Fixes #13869 - - - - - f3de8a3c by Zubin Duggal at 2024-02-26T15:17:57-05:00 rel-eng/fetch-gitlab.py: Fix name of aarch64 alpine 3_18 release job - - - - - c71bfdff by Cheng Shao at 2024-02-26T15:18:35-05:00 hadrian/hie-bios: pass -j to hadrian This commit passes -j to hadrian in the hadrian/hie-bios scripts. When the user starts HLS in a fresh clone that has just been configured, it takes quite a while for hie-bios to pick up the ghc flags and start actual indexing, due to the fact that the hadrian build step defaulted to -j1, so -j speeds things up and improve HLS user experience in GHC. Also add -j flag to .ghcid to speed up ghcid, and sets the Windows build root to .hie-bios which also works and unifies with other platforms, the previous build root _hie-bios was missing from .gitignore anyway. - - - - - 50bfdb46 by Cheng Shao at 2024-02-26T15:18:35-05:00 ci: enable parallelism in hadrian/ghci scripts This commit enables parallelism when the hadrian/ghci scripts are called in CI. The time bottleneck is in the hadrian build step, but previously the build step wasn't parallelized. - - - - - 61a78231 by Felix Yan at 2024-02-26T15:19:14-05:00 m4: Correctly detect GCC version When calling as `cc`, GCC does not outputs lowercased "gcc" at least in 13.2.1 version here. ``` $ cc --version cc (GCC) 13.2.1 20230801 ... ``` This fails the check and outputs the confusing message: `configure: $CC is not gcc; assuming it's a reasonably new C compiler` This patch makes it check for upper-cased "GCC" too so that it works correctly: ``` checking version of gcc... 13.2.1 ``` - - - - - 001aa539 by Teo Camarasu at 2024-02-27T13:26:46-05:00 Fix formatting in whereFrom docstring Previously it used markdown syntax rather than Haddock syntax for code quotes - - - - - e8034d15 by Teo Camarasu at 2024-02-27T13:26:46-05:00 Move ClosureType type to ghc-internal - Use ClosureType for InfoProv.ipDesc. - Use ClosureType for CloneStack.closureType. - Now ghc-heap re-exports this type from ghc-internal. See the accompanying CLC proposal: https://github.com/haskell/core-libraries-committee/issues/210 Resolves #22600 - - - - - 3da0a551 by Matthew Craven at 2024-02-27T13:27:22-05:00 StgToJS: Simplify ExprInline constructor of ExprResult Its payload was used only for a small optimization in genAlts, avoiding a few assignments for programs of this form: case NormalDataCon arg1 arg2 of x { NormalDataCon x1 x2 -> ... ; } But when compiling with optimizations, this sort of code is generally eliminated by case-of-known-constructor in Core-to-Core. So it doesn't seem worth tracking and cleaning up again in StgToJS. - - - - - 61bc92cc by Cheng Shao at 2024-02-27T16:58:42-05:00 rts: add missing ccs_mutex guard to internal_dlopen See added comment for details. Closes #24423. - - - - - dd29d3b2 by doyougnu at 2024-02-27T16:59:23-05:00 cg: Remove GHC.Cmm.DataFlow.Collections In pursuit of #15560 and #17957 and generally removing redundancy. - - - - - d3a050d2 by Cheng Shao at 2024-02-27T17:00:00-05:00 utils: remove unused lndir from tree Ever since the removal of the make build system, the in tree lndir hasn't been actually built, so this patch removes it. - - - - - 74b24a9b by Teo Camarasu at 2024-02-28T16:32:58+00:00 rts: avoid checking bdescr of value outside of Haskell heap In nonmovingTidyWeaks we want to check if the key of a weak pointer lives in the non-moving heap. We do this by checking the flags of the block the key lives in. But we need to be careful with values that live outside the Haskell heap, since they will lack a block descriptor and looking for one may lead to a segfault. In this case we should just accept that it isn't on the non-moving heap. Resolves #24492 - - - - - b4cae4ec by Simon Peyton Jones at 2024-02-29T02:10:08-05:00 In mkDataConRep, ensure the in-scope set is right A small change that fixes #24489 - - - - - 3836a110 by Cheng Shao at 2024-02-29T21:25:45-05:00 testsuite: fix T23540 fragility on 32-bit platforms T23540 is fragile on 32-bit platforms. The root cause is usage of `getEvidenceTreesAtPoint`, which internally relies on `Name`'s `Ord` instance, which is indeterministic. The solution is adding a deterministic `Ord` instance for `EvidenceInfo` and sorting the evidence trees before pretty printing. Fixes #24449. - - - - - 960c8d47 by Teo Camarasu at 2024-02-29T21:26:20-05:00 Reduce AtomicModifyIORef increment count This test leads to a lot of contention when N>2 and becomes very slow. Let's reduce the amount of work we do to compensate. Resolves #24490 - - - - - 2e46c8ad by Matthew Pickering at 2024-03-01T05:48:06-05:00 hadrian: Improve parallelism in binary-dist-dir rule I noticed that the "docs" target was needed after the libraries and executables were built. We can improve the parallelism by needing everything at once so that documentation can be built immediately after a library is built for example. - - - - - cb6c11fe by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: Bump windows and freebsd boot compilers to 9.6.4 We have previously bumped the docker images to use 9.6.4, but neglected to bump the windows images until now. - - - - - 30f06996 by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: darwin: Update to 9.6.2 for boot compiler 9.6.4 is currently broken due to #24050 Also update to use LLVM-15 rather than LLVM-11, which is out of date. - - - - - d9d69e12 by Matthew Pickering at 2024-03-01T05:48:07-05:00 Bump minimum bootstrap version to 9.6 - - - - - 67ace1c5 by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: Enable more documentation building Here we enable documentation building on 1. Darwin: The sphinx toolchain was already installed so we enable html and manpages. 2. Rocky8: Full documentation (toolchain already installed) 3. Alpine: Full documetnation (toolchain already installed) 4. Windows: HTML and manpages (toolchain already installed) Fixes #24465 - - - - - 39583c39 by Matthew Pickering at 2024-03-01T05:48:42-05:00 ci: Bump ci-images to allow updated aarch64-alpine image with llvm15 and clang15 - - - - - d91d00fc by Torsten Schmits at 2024-03-01T15:01:50-05:00 Introduce ListTuplePuns extension This implements Proposal 0475, introducing the `ListTuplePuns` extension which is enabled by default. Disabling this extension makes it invalid to refer to list, tuple and sum type constructors by using built-in syntax like `[Int]`, `(Int, Int)`, `(# Int#, Int# #)` or `(# Int | Int #)`. Instead, this syntax exclusively denotes data constructors for use with `DataKinds`. The conventional way of referring to these data constructors by prefixing them with a single quote (`'(Int, Int)`) is now a parser error. Tuple declarations have been moved to `GHC.Tuple.Prim` and the `Solo` data constructor has been renamed to `MkSolo` (in a previous commit). Unboxed tuples and sums now have real source declarations in `GHC.Types`. Unit and solo types for tuples are now called `Unit`, `Unit#`, `Solo` and `Solo#`. Constraint tuples now have the unambiguous type constructors `CTuple<n>` as well as `CUnit` and `CSolo`, defined in `GHC.Classes` like before. A new parser construct has been added for the unboxed sum data constructor declarations. The type families `Tuple`, `Sum#` etc. that were intended to provide nicer syntax have been omitted from this change set due to inference problems, to be implemented at a later time. See the MR discussion for more info. Updates the submodule utils/haddock. Updates the cabal submodule due to new language extension. Metric Increase: haddock.base Metric Decrease: MultiLayerModulesTH_OneShot size_hello_artifact Proposal document: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst Merge request: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8820 Tracking ticket: https://gitlab.haskell.org/ghc/ghc/-/issues/21294 - - - - - bbdb6286 by Sylvain Henry at 2024-03-01T15:01:50-05:00 JS linker: filter unboxed tuples - - - - - dec6d8d3 by Arnaud Spiwack at 2024-03-01T15:02:30-05:00 Improve error messages coming from non-linear patterns This enriched the `CtOrigin` for non-linear patterns to include data of the pattern that created the constraint (which can be quite useful if it occurs nested in a pattern) as well as an explanation why the pattern is non-restricted in (at least in some cases). - - - - - 6612388e by Arnaud Spiwack at 2024-03-01T15:02:30-05:00 Adjust documentation of linear lets according to committee decision - - - - - 1c064ef1 by Cheng Shao at 2024-03-02T17:11:19-05:00 compiler: start deprecating cmmToRawCmmHook cmmToRawCmmHook was added 4 years ago in d561c8f6244f8280a2483e8753c38e39d34c1f01. Its only user is the Asterius project, which has been archived and deprecated in favor of the ghc wasm backend. This patch starts deprecating cmmToRawCmmHook by placing a DEPRECATED pragma, and actual removal shall happen in a future GHC major release if no issue to oppose the deprecation has been raised in the meantime. - - - - - 9b74845f by Andrew Lelechenko at 2024-03-02T17:11:55-05:00 Data.List.NonEmpty.unzip: use WARNING with category instead of DEPRECATED CLC proposal: https://github.com/haskell/core-libraries-committee/issues/258 - - - - - 61bb5ff6 by Finley McIlwaine at 2024-03-04T09:01:40-08:00 add -fprof-late-overloaded and -fprof-late-overloaded-calls * Refactor late cost centre insertion for extensibility * Add two more late cost centre insertion methods that add SCCs to overloaded top level bindings and call sites with dictionary arguments. * Some tests for the basic functionality of the new insertion methods Resolves: #24500 - - - - - 82ccb801 by Andreas Klebinger at 2024-03-04T19:59:14-05:00 x86-ncg: Fix fma codegen when arguments are globals Fix a bug in the x86 ncg where results would be wrong when the desired output register and one of the input registers were the same global. Also adds a tiny optimization to make use of the memory addressing support when convenient. Fixes #24496 - - - - - 18ad1077 by Matthew Pickering at 2024-03-05T14:22:31-05:00 rel_eng: Update hackage docs upload scripts This adds the upload of ghc-internal and ghc-experimental to our scripts which upload packages to hackage. - - - - - bf47c9ba by Matthew Pickering at 2024-03-05T14:22:31-05:00 docs: Remove stray module comment from GHC.Profiling.Eras - - - - - 37d9b340 by Matthew Pickering at 2024-03-05T14:22:31-05:00 Fix ghc-internal cabal file The file mentioned some artifacts relating to the base library. I have renamed these to the new ghc-internal variants. - - - - - 23f2a478 by Matthew Pickering at 2024-03-05T14:22:31-05:00 Fix haddock source links and hyperlinked source There were a few issues with the hackage links: 1. We were using the package id rather than the package name for the package links. This is fixed by now allowing the template to mention %pkg% or %pkgid% and substituing both appropiatly. 2. The `--haddock-base-url` flag is renamed to `--haddock-for-hackage` as the new base link works on a local or remote hackage server. 3. The "src" path including too much stuff, so cross-package source links were broken as the template was getting double expanded. Fixes #24086 - - - - - 2fa336a9 by Ben Gamari at 2024-03-05T14:23:07-05:00 filepath: Bump submodule to 1.5.2.0 - - - - - 31217944 by Ben Gamari at 2024-03-05T14:23:07-05:00 os-string: Bump submodule to 2.0.2 - - - - - 4074a3f2 by Matthew Pickering at 2024-03-05T21:44:35-05:00 base: Reflect new era profiling RTS flags in GHC.RTS.Flags * -he profiling mode * -he profiling selector * --automatic-era-increment CLC proposal #254 - https://github.com/haskell/core-libraries-committee/issues/254 - - - - - a8c0e31b by Sylvain Henry at 2024-03-05T21:45:14-05:00 JS: faster implementation for some numeric primitives (#23597) Use faster implementations for the following primitives in the JS backend by not using JavaScript's BigInt: - plusInt64 - minusInt64 - minusWord64 - timesWord64 - timesInt64 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 21e3f325 by Cheng Shao at 2024-03-05T21:45:52-05:00 rts: add -xr option to control two step allocator reserved space size This patch adds a -xr RTS option to control the size of virtual memory address space reserved by the two step allocator on a 64-bit platform, see added documentation for explanation. Closes #24498. - - - - - dedcf102 by Cheng Shao at 2024-03-06T13:39:04-05:00 rts: expose HeapAlloc.h as public header This commit exposes HeapAlloc.h as a public header. The intention is to expose HEAP_ALLOCED/HEAP_ALLOCED_GC, so they can be used in assertions in other public headers, and they may also be useful for user code. - - - - - d19441d7 by Cheng Shao at 2024-03-06T13:39:04-05:00 rts: assert pointer is indeed heap allocated in Bdescr() This commit adds an assertion to Bdescr() to assert the pointer is indeed heap allocated. This is useful to rule out RTS bugs that attempt to access non-existent block descriptor of a static closure, #24492 being one such example. - - - - - 9a656a04 by Ben Gamari at 2024-03-06T13:39:39-05:00 ghc-experimental: Add dummy dependencies to work around #23942 This is a temporary measure to improve CI reliability until a proper solution is developed. Works around #23942. - - - - - 1e84b924 by Simon Peyton Jones at 2024-03-06T13:39:39-05:00 Three compile perf improvements with deep nesting These were changes are all triggered by #24471. 1. Make GHC.Core.Opt.SetLevels.lvlMFE behave better when there are many free variables. See Note [Large free-variable sets]. 2. Make GHC.Core.Opt.Arity.floatIn a bit lazier in its Cost argument. This benefits the common case where the ArityType turns out to be nullary. See Note [Care with nested expressions] 3. Make GHC.CoreToStg.Prep.cpeArg behave for deeply-nested expressions. See Note [Eta expansion of arguments in CorePrep] wrinkle (EA2). Compile times go down by up to 4.5%, and much more in artificial cases. (Geo mean of compiler/perf changes is -0.4%.) Metric Decrease: CoOpt_Read T10421 T12425 - - - - - c4b13113 by Hécate Moonlight at 2024-03-06T13:40:17-05:00 Use "module" instead of "library" when applicable in base haddocks - - - - - 9cd9efb4 by Vladislav Zavialov at 2024-03-07T13:01:54+03:00 Rephrase error message to say "visible arguments" (#24318) * Main change: make the error message generated by mkFunTysMsg more accurate by changing "value arguments" to "visible arguments". * Refactor: define a new type synonym VisArity and use it instead of Arity in a few places. It might be the case that there other places in the compiler that should talk about visible arguments rather than value arguments, but I haven't tried to find them all, focusing only on the error message reported in the ticket. - - - - - d523a6a7 by Ben Gamari at 2024-03-07T19:40:45-05:00 Bump array submodule - - - - - 7e55003c by Ben Gamari at 2024-03-07T19:40:45-05:00 Bump stm submodule - - - - - 32d337ef by Ben Gamari at 2024-03-07T19:40:45-05:00 Introduce exception context Here we introduce the `ExceptionContext` type and `ExceptionAnnotation` class, allowing dynamically-typed user-defined annotations to be attached to exceptions. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/199 GHC Proposal: https://github.com/ghc-proposals/ghc-proposals/pull/330 - - - - - 39f3d922 by Ben Gamari at 2024-03-07T19:40:46-05:00 testsuite/interface-stability: Update documentation - - - - - fdea7ada by Ben Gamari at 2024-03-07T19:40:46-05:00 ghc-internal: comment formatting - - - - - 4fba42ef by Ben Gamari at 2024-03-07T19:40:46-05:00 compiler: Default and warn ExceptionContext constraints - - - - - 3886a205 by Ben Gamari at 2024-03-07T19:40:46-05:00 base: Introduce exception backtraces Here we introduce the `Backtraces` type and associated machinery for attaching these via `ExceptionContext`. These has a few compile-time regressions (`T15703` and `T9872d`) due to the additional dependencies in the exception machinery. As well, there is a surprisingly large regression in the `size_hello_artifact` test. This appears to be due to various `Integer` and `Read` bits now being reachable at link-time. I believe it should be possible to avoid this but I have accepted the change for now to get the feature merged. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/199 GHC Proposal: https://github.com/ghc-proposals/ghc-proposals/pull/330 Metric Increase: T15703 T9872d size_hello_artifact - - - - - 18c5409f by Ben Gamari at 2024-03-07T19:40:46-05:00 users guide: Release notes for exception backtrace work - - - - - f849c5fc by Ben Gamari at 2024-03-07T19:40:46-05:00 compiler: Don't show ExceptionContext of GhcExceptions Most GhcExceptions are user-facing errors and therefore the ExceptionContext has little value. Ideally we would enable it in the DEBUG compiler but I am leaving this for future work. - - - - - dc646e6f by Sylvain Henry at 2024-03-07T19:40:46-05:00 Disable T9930fail for the JS target (cf #19174) - - - - - bfc09760 by Alan Zimmerman at 2024-03-07T19:41:22-05:00 Update showAstData to honour blanking of AnnParen Also tweak rendering of SrcSpan to remove extra blank line. - - - - - 50454a29 by Ben Gamari at 2024-03-08T03:32:42-05:00 ghc-internal: Eliminate GHC.Internal.Data.Kind This was simply reexporting things from `ghc-prim`. Instead reexport these directly from `Data.Kind`. Also add build ordering dependency to work around #23942. - - - - - 38a4b6ab by Ben Gamari at 2024-03-08T03:33:18-05:00 rts: Fix SET_HDR initialization of retainer set This fixes a regression in retainer set profiling introduced by b0293f78cb6acf2540389e22bdda420d0ab874da. Prior to that commit the heap traversal word would be initialized by `SET_HDR` using `LDV_RECORD_CREATE`. However, the commit added a `doingLDVProfiling` check in `LDV_RECORD_CREATE`, meaning that this initialization no longer happened. Given that this initialization was awkwardly indirectly anyways, I have fixed this by explicitly initializating the heap traversal word to `NULL` in `SET_PROF_HDR`. This is equivalent to the previous behavior, but much more direct. Fixes #24513. - - - - - 2859a637 by Ben Gamari at 2024-03-08T18:26:47-05:00 base: Use strerror_r instead of strerror As noted by #24344, `strerror` is not necessarily thread-safe. Thankfully, POSIX.1-2001 has long offered `strerror_r`, which is safe to use. Fixes #24344. CLC discussion: https://github.com/haskell/core-libraries-committee/issues/249 - - - - - edb9bf77 by Jade at 2024-03-09T03:39:38-05:00 Error messages: Improve Error messages for Data constructors in type signatures. This patch improves the error messages from invalid type signatures by trying to guess what the user did and suggesting an appropriate fix. Partially fixes: #17879 - - - - - cfb197e3 by Patrick at 2024-03-09T03:40:15-05:00 HieAst: add module name #24493 The main purpose of this is to tuck the module name `xxx` in `module xxx where` into the hieAst. It should fix #24493. The following have been done: 1. Renamed and update the `tcg_doc_hdr :: Maybe (LHsDoc GhcRn)` to `tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName))` To store the located module name information. 2. update the `RenamedSource` and `RenamedStuff` with extra `Maybe (XRec GhcRn ModuleName)` located module name information. 3. add test `testsuite/tests/hiefile/should_compile/T24493.hs` to ensure the module name is added and update several relevent tests. 4. accompanied submodule haddoc test update MR in https://gitlab.haskell.org/ghc/haddock/-/merge_requests/53 - - - - - 2341d81e by Vaibhav Sagar at 2024-03-09T03:40:54-05:00 GHC.Utils.Binary: fix a couple of typos - - - - - 5580e1bd by Ben Gamari at 2024-03-09T03:41:30-05:00 rts: Drop .wasm suffix from .prof file names This replicates the behavior on Windows, where `Hi.exe` will produce profiling output named `Hi.prof` instead of `Hi.exe.prof`. While in the area I also fixed the extension-stripping logic, which incorrectly rewrote `Hi.exefoo` to `Hi.foo`. Closes #24515. - - - - - 259495ee by Cheng Shao at 2024-03-09T03:41:30-05:00 testsuite: drop exe extension from .hp & .prof filenames See #24515 for details. - - - - - c477a8d2 by Ben Gamari at 2024-03-09T03:42:05-05:00 rts/linker: Enable GOT support on all platforms There is nothing platform-dependent about our GOT implementation and GOT support is needed by `T24171` on i386. - - - - - 2e592857 by Vladislav Zavialov at 2024-03-09T03:42:41-05:00 Drop outdated comment on TcRnIllformedTypePattern This should have been done in 0f0c53a501b but I missed it. - - - - - c554b4da by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/CloneStack: Bounds check array write - - - - - 15c590a5 by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/CloneStack: Don't expose helper functions in header - - - - - e831ce31 by Ben Gamari at 2024-03-09T09:39:20-05:00 base: Move internals of GHC.InfoProv into GHC.InfoProv.Types Such that we can add new helpers into GHC.InfoProv.Types without breakage. - - - - - 6948e24d by Ben Gamari at 2024-03-09T09:39:20-05:00 rts: Lazily decode IPE tables Previously we would eagerly allocate `InfoTableEnt`s for each info table registered in the info table provenance map. However, this costs considerable memory and initialization time. Instead we now lazily decode these tables. This allows us to use one-third the memory *and* opens the door to taking advantage of sharing opportunities within a module. This required considerable reworking since lookupIPE now must be passed its result buffer. - - - - - 9204a04e by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/IPE: Don't expose helper in header - - - - - 308926ff by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/IPE: Share module_name within a Node This allows us to shave a 64-bit word off of the packed IPE entry size. - - - - - bebdea05 by Ben Gamari at 2024-03-09T09:39:20-05:00 IPE: Expose unit ID in InfoTableProv Here we add the unit ID to the info table provenance structure. - - - - - 6519c9ad by Ben Gamari at 2024-03-09T09:39:35-05:00 rts: Refactor GHC.Stack.CloneStack.decode Don't allocate a Ptr constructor per frame. - - - - - ed0b69dc by Ben Gamari at 2024-03-09T09:39:35-05:00 base: Do not expose whereFrom# from GHC.Exts - - - - - 2b1faea9 by Vladislav Zavialov at 2024-03-09T17:38:21-05:00 docs: Update info on TypeAbstractions * Mention TypeAbstractions in 9.10.1-notes.rst * Set the status to "Experimental". * Add a "Since: GHC 9.x" comment to each section. - - - - - f8b88918 by Ben Gamari at 2024-03-09T21:21:46-05:00 ci-images: Bump Alpine image to bootstrap with 9.8.2 - - - - - 705e6927 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Mark T24171 as fragile due to #24512 I will fix this but not in time for 9.10.1-alpha1 - - - - - c74196e1 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Mark linker_unload_native as fragile In particular this fails on platforms without `dlinfo`. I plan to address this but not before 9.10.1-alpha1. - - - - - f4d87f7a by Ben Gamari at 2024-03-09T21:21:46-05:00 configure: Bump version to 9.10 - - - - - 88df9a5f by Ben Gamari at 2024-03-09T21:21:46-05:00 Bump transformers submodule to 0.6.1.1 - - - - - 8176d5e8 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Increase ulimit for T18623 1 MByte was just too tight and failed intermittently on some platforms (e.g. CentOS 7). Bumping the limit to 8 MByte should provide sufficient headroom. Fixes #23139. - - - - - c74b38a3 by Ben Gamari at 2024-03-09T21:21:46-05:00 base: Bump version to 4.20.0.0 - - - - - b2937fc3 by Ben Gamari at 2024-03-09T21:21:46-05:00 ghc-internal: Set initial version at 9.1001.0 This provides PVP compliance while maintaining a clear correspondence between GHC releases and `ghc-internal` versions. - - - - - 4ae7d868 by Ben Gamari at 2024-03-09T21:21:46-05:00 ghc-prim: Bump version to 0.11.0 - - - - - 50798dc6 by Ben Gamari at 2024-03-09T21:21:46-05:00 template-haskell: Bump version to 2.22.0.0 - - - - - 8564f976 by Ben Gamari at 2024-03-09T21:21:46-05:00 base-exports: Accommodate spurious whitespace changes in 32-bit output It appears that this was - - - - - 9d4f0e98 by Ben Gamari at 2024-03-09T21:21:46-05:00 users-guide: Move exception backtrace relnotes to 9.10 This was previously mistakenly added to the GHC 9.8 release notes. - - - - - 145eae60 by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/rel_eng: Fix name of Rocky8 artifact - - - - - 39c2a630 by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/rel_eng: Fix path of generate_jobs_metadata - - - - - aed034de by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/upload: Rework recompression The old `combine` approach was quite fragile due to use of filename globbing. Moreover, it didn't parallelize well. This refactoring makes the goal more obvious, parallelizes better, and is more robust. - - - - - dc207d06 by Ben Gamari at 2024-03-10T08:56:08-04:00 configure: Bump GHC version to 9.11 Bumps haddock submodule. - - - - - 8b2513e8 by Ben Gamari at 2024-03-11T01:20:03-04:00 rts/linker: Don't unload code when profiling is enabled The heap census may contain references (e.g. `Counter.identity`) to static data which must be available when the census is reported at the end of execution. Fixes #24512. - - - - - 7810b4c3 by Ben Gamari at 2024-03-11T01:20:03-04:00 rts/linker: Don't unload native objects when dlinfo isn't available To do so is unsafe as we have no way of identifying references to symbols provided by the object. Fixes #24513. Fixes #23993. - - - - - 0590764c by Ben Gamari at 2024-03-11T01:20:39-04:00 rel_eng/upload: Purge both $rel_name/ and $ver/ This is necessary for prereleases, where GHCup accesses the release via `$ver/` - - - - - b85a4631 by Brandon Chinn at 2024-03-12T19:25:56-04:00 Remove duplicate code normalising slashes - - - - - c91946f9 by Brandon Chinn at 2024-03-12T19:25:56-04:00 Simplify regexes with raw strings - - - - - 1a5f53c6 by Brandon Chinn at 2024-03-12T19:25:57-04:00 Don't normalize backslashes in characters - - - - - 7ea971d3 by Andrei Borzenkov at 2024-03-12T19:26:32-04:00 Fix compiler crash caused by implicit RHS quantification in type synonyms (#24470) - - - - - 39f3ac3e by Cheng Shao at 2024-03-12T19:27:11-04:00 Revert "compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms" This reverts commit 615eb855416ce536e02ed935ecc5a6f25519ae16. It was originally intended to fix #24449, but it was merely sweeping the bug under the rug. 3836a110577b5c9343915fd96c1b2c64217e0082 has properly fixed the fragile test, and we no longer need the C version of genSym. Furthermore, the C implementation causes trouble when compiling with clang that targets i386 due to alignment warning and libatomic linking issue, so it makes sense to revert it. - - - - - e6bfb85c by Cheng Shao at 2024-03-12T19:27:11-04:00 compiler: fix out-of-bound memory access of genSym on 32-bit This commit fixes an unnoticed out-of-bound memory access of genSym on 32-bit. ghc_unique_inc is 32-bit sized/aligned on 32-bit platforms, but we mistakenly treat it as a Word64 pointer in genSym, and therefore will accidentally load 2 garbage higher bytes, or with a small but non-zero chance, overwrite something else in the data section depends on how the linker places the data segments. This regression was introduced in !11802 and fixed here. - - - - - 77171cd1 by Ben Orchard at 2024-03-14T09:00:40-04:00 Note mutability of array and address access primops Without an understanding of immutable vs. mutable memory, the index primop family have a potentially non-intuitive type signature: indexOffAddr :: Addr# -> Int# -> a readOffAddr :: Addr# -> Int# -> State# d -> (# State# d, a #) indexOffAddr# might seem like a free generality improvement, which it certainly is not! This change adds a brief note on mutability expectations for most index/read/write access primops. - - - - - 7da7f8f6 by Alan Zimmerman at 2024-03-14T09:01:15-04:00 EPA: Fix regression discarding comments in contexts Closes #24533 - - - - - 73be65ab by Fendor at 2024-03-19T01:42:53-04:00 Fix sharing of 'IfaceTyConInfo' during core to iface type translation During heap analysis, we noticed that during generation of 'mi_extra_decls' we have lots of duplicates for the instances: * `IfaceTyConInfo NotPromoted IfaceNormalTyCon` * `IfaceTyConInfo IsPromoted IfaceNormalTyCon` which should be shared instead of duplicated. This duplication increased the number of live bytes by around 200MB while loading the agda codebase into GHCi. These instances are created during `CoreToIface` translation, in particular `toIfaceTyCon`. The generated core looks like: toIfaceTyCon = \ tc_sjJw -> case $wtoIfaceTyCon tc_sjJw of { (# ww_sjJz, ww1_sjNL, ww2_sjNM #) -> IfaceTyCon ww_sjJz (IfaceTyConInfo ww1_sjNL ww2_sjNM) } whichs removes causes the sharing to work propery. Adding explicit sharing, with NOINLINE annotations, changes the core to: toIfaceTyCon = \ tc_sjJq -> case $wtoIfaceTyCon tc_sjJq of { (# ww_sjNB, ww1_sjNC #) -> IfaceTyCon ww_sjNB ww1_sjNC } which looks much more like sharing is happening. We confirmed via ghc-debug that all duplications were eliminated and the number of live bytes are noticeably reduced. - - - - - bd8209eb by Alan Zimmerman at 2024-03-19T01:43:28-04:00 EPA: Address more 9.10.1-alpha1 regressions from recent changes Closes #24533 Hopefully for good this time - - - - - 31bf85ee by Fendor at 2024-03-19T14:48:08-04:00 Escape multiple arguments in the settings file Uses responseFile syntax. The issue arises when GHC is installed on windows into a location that has a space, for example the user name is 'Fake User'. The $topdir will also contain a space, consequentially. When we resolve the top dir in the string `-I$topdir/mingw/include`, then `words` will turn this single argument into `-I/C/Users/Fake` and `User/.../mingw/include` which trips up the flag argument parser of various tools such as gcc or clang. We avoid this by escaping the $topdir before replacing it in `initSettngs`. Additionally, we allow to escape spaces and quotation marks for arguments in `settings` file. Add regression test case to count the number of options after variable expansion and argument escaping took place. Additionally, we check that escaped spaces and double quotation marks are correctly parsed. - - - - - f45f700e by Matthew Pickering at 2024-03-19T14:48:44-04:00 Read global package database from settings file Before this patch, the global package database was always assumed to be in libdir </> package.conf.d. This causes issues in GHC's build system because there are sometimes situations where the package database you need to use is not located in the same place as the settings file. * The stage1 compiler needs to use stage1 libraries, so we should set "Global Package DB" for the stage1 compiler to the stage1 package database. * Stage 2 cross compilers need to use stage2 libraries, so likewise, we should set the package database path to `_build/stage2/lib/` * The normal situation is where the stage2 compiler uses stage1 libraries. Then everything lines up. * When installing we have rearranged everything so that the settings file and package database line up properly, so then everything should continue to work as before. In this case we set the relative package db path to `package.conf.d`, so it resolves the same as before. * ghc-pkg needs to be modified as well to look in the settings file fo the package database rather than assuming the global package database location relative to the lib folder. * Cabal/cabal-install will work correctly because they query the global package database using `--print-global-package-db`. A reasonable question is why not generate the "right" settings files in the right places in GHC's build system. In order to do this you would need to engineer wrappers for all executables to point to a specific libdir. There are also situations where the same package db is used by two different compilers with two different settings files (think stage2 cross compiler and stage3 compiler). In short, this 10 line patch allows for some reasonable simplifications in Hadrian at very little cost to anything else. Fixes #24502 - - - - - 4c8f1794 by Matthew Pickering at 2024-03-19T14:48:44-04:00 hadrian: Remove stage1 testsuite wrappers logic Now instead of producing wrappers which pass the global package database argument to ghc and ghc-pkg, we write the location of the correct package database into the settings file so you can just use the intree compiler directly. - - - - - da0d8ba5 by Matthew Craven at 2024-03-19T14:49:20-04:00 Remove unused ghc-internal module "GHC.Internal.Constants" - - - - - b56d2761 by Matthew Craven at 2024-03-19T14:49:20-04:00 CorePrep: Rework lowering of BigNat# literals Don't use bigNatFromWord#, because that's terrible: * We shouldn't have to traverse a linked list at run-time to build a BigNat# literal. That's just silly! * The static List object we have to create is much larger than the actual BigNat#'s contents, bloating code size. * We have to read the corresponding interface file, which causes un-tracked implicit dependencies. (#23942) Instead, encode them into the appropriate platform-dependent sequence of bytes, and generate code that copies these bytes at run-time from an Addr# literal into a new ByteArray#. A ByteArray# literal would be the correct thing to generate, but these are not yet supported; see also #17747. Somewhat surprisingly, this change results in a slight reduction in compiler allocations, averaging around 0.5% on ghc's compiler performance tests, including when compiling programs that contain no bignum literals to begin with. The specific cause of this has not been investigated. Since this lowering no longer reads the interface file for GHC.Num.BigNat, the reasoning in Note [Depend on GHC.Num.Integer] is obsoleted. But the story of un-tracked built-in dependencies remains complex, and Note [Tracking dependencies on primitives] now exists to explain this complexity. Additionally, many empty imports have been modified to refer to this new note and comply with its guidance. Several empty imports necessary for other reasons have also been given brief explanations. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 349ea330 by Fendor at 2024-03-19T14:50:00-04:00 Eliminate thunk in 'IfaceTyCon' Heap analysis showed that `IfaceTyCon` retains a thunk to `IfaceTyConInfo`, defeating the sharing of the most common instances of `IfaceTyConInfo`. We make sure the indirection is removed by adding bang patterns to `IfaceTyCon`. Experimental results on the agda code base, where the `mi_extra_decls` were read from disk: Before this change, we observe around 8654045 instances of: `IfaceTyCon[Name,THUNK_1_0]` But these thunks almost exclusively point to a shared value! Forcing the thunk a little bit more, leads to `ghc-debug` reporting: `IfaceTyCon[Name:Name,IfaceTyConInfo]` and a noticeable reduction of live bytes (on agda ~10%). - - - - - 594bee0b by Krzysztof Gogolewski at 2024-03-19T14:50:36-04:00 Minor misc cleanups - GHC.HsToCore.Foreign.JavaScript: remove dropRuntimeRepArgs; boxed tuples don't take RuntimeRep args - GHC.HsToCore.Foreign.Call: avoid partial pattern matching - GHC.Stg.Unarise: strengthen the assertion; we can assert that non-rubbish literals are unary rather than just non-void - GHC.Tc.Gen.HsType: make sure the fsLit "literal" rule fires - users_guide/using-warnings.rst: remove -Wforall-identifier, now deprecated and does nothing - users_guide/using.rst: fix formatting - andy_cherry/test.T: remove expect_broken_for(23272...), 23272 is fixed The rest are simple cleanups. - - - - - cf55a54b by Ben Gamari at 2024-03-19T14:51:12-04:00 mk/relpath: Fix quoting Previously there were two instances in this script which lacked proper quoting. This resulted in `relpath` invocations in the binary distribution Makefile producing incorrect results on Windows, leading to confusing failures from `sed` and the production of empty package registrations. Fixes #24538. - - - - - 5ff88389 by Bryan Richter at 2024-03-19T14:51:48-04:00 testsuite: Disable T21336a on wasm - - - - - 60023351 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian/bindist: Eliminate extraneous `dirname` invocation Previously we would call `dirname` twice per installed library file. We now instead reuse this result. This helps appreciably on Windows, where processes are quite expensive. - - - - - 616ac300 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian: Package mingw toolchain in expected location This fixes #24525, a regression due to 41cbaf44a6ab5eb9fa676d65d32df8377898dc89. Specifically, GHC expects to find the mingw32 toolchain in the binary distribution root. However, after this patch it was packaged in the `lib/` directory. - - - - - de9daade by Ben Gamari at 2024-03-19T22:33:11-04:00 gitlab/rel_eng: More upload.sh tweaks - - - - - 1dfe12db by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_eng: Drop dead prepare_docs codepath - - - - - dd2d748b by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_env/recompress_all: unxz before recompressing Previously we would rather compress the xz *again*, before in addition compressing it with the desired scheme. Fixes #24545. - - - - - 9d936c57 by Ben Gamari at 2024-03-19T22:33:11-04:00 mk-ghcup-metadata: Fix directory of testsuite tarball As reported in #24546, the `dlTest` artifact should be extracted into the `testsuite` directory. - - - - - 6d398066 by Ben Gamari at 2024-03-19T22:33:11-04:00 ghcup-metadata: Don't populate dlOutput unless necessary ghcup can apparently infer the output name of an artifact from its URL. Consequently, we should only include the `dlOutput` field when it would differ from the filename of `dlUri`. Fixes #24547. - - - - - 576f8b7e by Zubin Duggal at 2024-03-19T22:33:46-04:00 Revert "Apply shellcheck suggestion to SUBST_TOOLDIR" This reverts commit c82770f57977a2b5add6e1378f234f8dd6153392. The shellcheck suggestion is spurious and results in SUBST_TOOLDIR being a no-op. `set` sets positional arguments for bash, but we want to set the variable given as the first autoconf argument. Fixes #24542 Metric decreases because the paths in the settings file are now shorter, so we allocate less when we read the settings file. ------------------------- Metric Decrease: T12425 T13035 T9198 ------------------------- - - - - - cdfe6e01 by Fendor at 2024-03-19T22:34:22-04:00 Compact serialisation of IfaceAppArgs In #24563, we identified that IfaceAppArgs serialisation tags each cons cell element with a discriminator byte. These bytes add up quickly, blowing up interface files considerably when '-fwrite-if-simplified-core' is enabled. We compact the serialisation by writing out the length of 'IfaceAppArgs', followed by serialising the elements directly without any discriminator byte. This improvement can decrease the size of some interface files by up to 35%. - - - - - 97a2bb1c by Simon Peyton Jones at 2024-03-20T17:11:29+00:00 Expand untyped splices in tcPolyExprCheck Fixes #24559 - - - - - 5f275176 by Alan Zimmerman at 2024-03-20T22:44:12-04:00 EPA: Clean up Exactprint helper functions a bit - Introduce a helper lens to compose on `EpAnn a` vs `a` versions - Rename some prime versions of functions back to non-prime They were renamed during the rework - - - - - da2a10ce by Vladislav Zavialov at 2024-03-20T22:44:48-04:00 Type operators in promoteOccName (#24570) Type operators differ from term operators in that they are lexically classified as (type) constructors, not as (type) variables. Prior to this change, promoteOccName did not account for this difference, causing a scoping issue that affected RequiredTypeArguments. type (!@#) = Bool f = idee (!@#) -- Not in scope: ‘!@#’ (BUG) Now we have a special case in promoteOccName to account for this. - - - - - 247fc0fa by Preetham Gujjula at 2024-03-21T10:19:18-04:00 docs: Remove mention of non-existent Ord instance for Complex The documentation for Data.Complex says that the Ord instance for Complex Float is deficient, but there is no Ord instance for Complex a. The Eq instance for Complex Float is similarly deficient, so we use that as an example instead. - - - - - 6fafc51e by Andrei Borzenkov at 2024-03-21T10:19:54-04:00 Fix TH handling in `pat_to_type_pat` function (#24571) There was missing case for `SplicePat` in `pat_to_type_at` function, hence patterns with splicing that checked against `forall->` doesn't work properly because they fall into the "illegal pattern" case. Code example that is now accepted: g :: forall a -> () g $([p| a |]) = () - - - - - 52072f8e by Sylvain Henry at 2024-03-21T21:01:59-04:00 Type-check default declarations before deriving clauses (#24566) See added Note and #24566. Default declarations must be type-checked before deriving clauses. - - - - - 7dfdf3d9 by Sylvain Henry at 2024-03-21T21:02:40-04:00 Lexer: small perf changes - Use unsafeChr because we know our values to be valid - Remove some unnecessary use of `ord` (return Word8 values directly) - - - - - 864922ef by Sylvain Henry at 2024-03-21T21:02:40-04:00 JS: fix some comments - - - - - 3e0b2b1f by Sebastian Graf at 2024-03-21T21:03:16-04:00 Simplifier: Re-do dependency analysis in abstractFloats (#24551) In #24551, we abstracted a string literal binding over a type variable, triggering a CoreLint error when that binding floated to top-level. The solution implemented in this patch fixes this by re-doing dependency analysis on a simplified recursive let binding that is about to be type abstracted, in order to find the minimal set of type variables to abstract over. See wrinkle (AB5) of Note [Floating and type abstraction] for more details. Fixes #24551 - - - - - 8a8ac65a by Matthew Craven at 2024-03-23T00:20:52-04:00 Improve toInteger @Word32 on 64-bit platforms On 64-bit platforms, every Word32 fits in an Int, so we can convert to Int# without having to perform the overflow check integerFromWord# uses internally. - - - - - 0c48f2b9 by Apoorv Ingle at 2024-03-23T00:21:28-04:00 Fix for #24552 (see testcase T24552) Fixes for a bug in desugaring pattern synonyms matches, introduced while working on on expanding `do`-blocks in #18324 The `matchWrapper` unecessarily (and incorrectly) filtered out the default wild patterns in a match. Now the wild pattern alternative is simply ignored by the pm check as its origin is `Generated`. The current code now matches the expected semantics according to the language spec. - - - - - b72705e9 by Simon Peyton Jones at 2024-03-23T00:22:04-04:00 Print more info about kinds in error messages This fixes #24553, where GHC unhelpfully said error: [GHC-83865] • Expected kind ‘* -> * -> *’, but ‘Foo’ has kind ‘* -> * -> *’ See Note [Showing invisible bits of types in error messages] - - - - - 8f7cfc7e by Tristan Cacqueray at 2024-03-23T00:22:44-04:00 docs: remove the don't use float hint This hint is outdated, ``Complex Float`` are now specialised, and the heap space suggestion needs more nuance so it should be explained in the unboxed/storable array documentation. - - - - - 5bd8ed53 by Andreas Klebinger at 2024-03-23T16:18:33-04:00 NCG: Fix a bug in jump shortcutting. When checking if a jump has more than one destination account for the possibility of some jumps not being representable by a BlockId. We do so by having isJumpishInstr return a `Maybe BlockId` where Nothing represents non-BlockId jump destinations. Fixes #24507 - - - - - 8d67f247 by Ben Gamari at 2024-03-23T16:19:09-04:00 docs: Drop old release notes, add for 9.12.1 - - - - - 7db8c992 by Cheng Shao at 2024-03-25T13:45:46-04:00 rts: fix clang compilation on aarch64 This patch fixes function prototypes in ARMOutlineAtomicsSymbols.h which causes "error: address argument to atomic operation must be a pointer to _Atomic type" when compiling with clang on aarch64. - - - - - 237194ce by Sylvain Henry at 2024-03-25T13:46:27-04:00 Lexer: fix imports for Alex 3.5.1 (#24583) - - - - - 810660b7 by Cheng Shao at 2024-03-25T22:19:16-04:00 libffi-tarballs: bump libffi-tarballs submodule to libffi 3.4.6 This commit bumps the libffi-tarballs submodule to libffi 3.4.6, which includes numerous upstream libffi fixes, especially https://github.com/libffi/libffi/issues/760. - - - - - d2ba41e8 by Alan Zimmerman at 2024-03-25T22:19:51-04:00 EPA: do not duplicate comments in signature RHS - - - - - 32a8103f by Rodrigo Mesquita at 2024-03-26T21:16:12-04:00 configure: Use LDFLAGS when trying linkers A user may configure `LDFLAGS` but not `LD`. When choosing a linker, we will prefer `ldd`, then `ld.gold`, then `ld.bfd` -- however, we have to check for a working linker. If either of these fail, we try the next in line. However, we were not considering the `$LDFLAGS` when checking if these linkers worked. So we would pick a linker that does not support the current $LDFLAGS and fail further down the line when we used that linker with those flags. Fixes #24565, where `LDFLAGS=-Wl,-z,pack-relative-relocs` is not supported by `ld.gold` but that was being picked still. - - - - - bf65a7c3 by Rodrigo Mesquita at 2024-03-26T21:16:48-04:00 bindist: Clean xattrs of bin and lib at configure time For issue #21506, we started cleaning the extended attributes of binaries and libraries from the bindist *after* they were installed to workaround notarisation (#17418), as part of `make install`. However, the `ghc-toolchain` binary that is now shipped with the bindist must be run at `./configure` time. Since we only cleaned the xattributes of the binaries and libs after they were installed, in some situations users would be unable to run `ghc-toolchain` from the bindist, failing at configure time (#24554). In this commit we move the xattr cleaning logic to the configure script. Fixes #24554 - - - - - cfeb70d3 by Rodrigo Mesquita at 2024-03-26T21:17:24-04:00 Revert "NCG: Fix a bug in jump shortcutting." This reverts commit 5bd8ed53dcefe10b72acb5729789e19ceb22df66. Fixes #24586 - - - - - 13223f6d by Serge S. Gulin at 2024-03-27T07:28:51-04:00 JS: `h$rts_isProfiled` is removed from `profiling` and left its version at `rts/js/config.js` - - - - - 0acfe391 by Alan Zimmerman at 2024-03-27T07:29:27-04:00 EPA: Do not extend declaration range for trailine zero len semi The lexer inserts virtual semicolons having zero width. Do not use them to extend the list span of items in a list. - - - - - cd0fb82f by Alan Zimmerman at 2024-03-27T19:33:08+00:00 EPA: Fix FamDecl range The span was incorrect if opt_datafam_kind_sig was empty - - - - - f8f384a8 by Ben Gamari at 2024-03-29T01:23:03-04:00 Fix type of _get_osfhandle foreign import Fixes #24601. - - - - - 00d3ecf0 by Alan Zimmerman at 2024-03-29T12:19:10+00:00 EPA: Extend StringLiteral range to include trailing commas This goes slightly against the exact printing philosophy where trailing decorations should be in an annotation, but the practicalities of adding it to the WarningTxt environment, and the problems caused by deviating do not make a more principles approach worthwhile. - - - - - efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - c93eecf1 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 0a2c3c2d by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 6d605aa5 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 447f2ac0 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Spelling, layout, pretty-printing only - - - - - f36b9603 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 7fc8cfc3 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - a818823d by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - c471144d by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - 346115e0 by Simon Peyton Jones at 2024-04-02T21:20:44+01:00 Remove a long-commented-out line Pure refactoring - - - - - 57f42293 by Simon Peyton Jones at 2024-04-02T21:20:49+01:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - ec584eaf by Simon Peyton Jones at 2024-04-02T21:21:23+01:00 Testsuite message changes from simplifier improvements - - - - - 9c910ae1 by Simon Peyton Jones at 2024-04-02T21:21:23+01:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 193a923a by Simon Peyton Jones at 2024-04-02T23:10:24+01:00 Work in progress on unfoldings re-engineering - - - - - 7348c6d5 by Simon Peyton Jones at 2024-04-02T23:12:08+01:00 Fix a bad, subtle bug in exprIsConApp_maybe In extend_in_scope We were simply overwriting useful bindings in the in-scope set, notably ones that had unfoldings. That could lead to repeated simplifier iterations. - - - - - 8047f16e by Simon Peyton Jones at 2024-04-02T23:15:18+01:00 Minor refactoring... Plus: don't be so eager to inline when argument is a non-value, but has some struture. We want *some* incentive though. - - - - - d3d58548 by Simon Peyton Jones at 2024-04-02T23:17:05+01:00 Adjust * Reduce caseElimDiscount to 10 Example: f_nand in spectral/hartel/event is quite big but was still getting inlined; that make f_simulate too big for SpecConstr * Increase jumpSize. Not so much cheaper than tail calls. I'm trying making them the same size. - - - - - eb4d3511 by Simon Peyton Jones at 2024-04-02T23:17:05+01:00 Fix four bug in handling of (forall cv. body_ty) These bugs are all described in #24335 It's not easy to provoke the bug, hence no test case. - - - - - 25ba0892 by Simon Peyton Jones at 2024-04-02T23:17:06+01:00 Wibbles - - - - - 322f618a by Simon Peyton Jones at 2024-04-02T23:17:06+01:00 Wibble - - - - - 17174a9f by Simon Peyton Jones at 2024-04-02T23:47:03+01:00 Wibbles - - - - - 18 changed files: - .ghcid - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/default.nix - .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/recompress-all - .gitlab/rel_eng/upload.sh - .gitlab/rel_eng/upload_ghc_libs.py - CODEOWNERS - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a01474d0107062ecd2fe6101d271897c9658b3c7...17174a9f2574c5186a7f82a68496f40b25de8e03 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a01474d0107062ecd2fe6101d271897c9658b3c7...17174a9f2574c5186a7f82a68496f40b25de8e03 You're receiving 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 Apr 2 23:09:52 2024 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 02 Apr 2024 19:09:52 -0400 Subject: [Git][ghc/ghc][wip/expansions-appdo] make applicative breakpoint work Message-ID: <660c904041916_f9da437e728999eb@gitlab.mail> Apoorv Ingle pushed to branch wip/expansions-appdo at Glasgow Haskell Compiler / GHC Commits: f76e8cfd by Apoorv Ingle at 2024-04-02T18:09:39-05:00 make applicative breakpoint work - - - - - 9 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/Language/Haskell/Syntax/Expr.hs - testsuite/tests/ghci.debugger/scripts/break029.stdout Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -476,7 +476,7 @@ type instance XXExpr GhcTc = XXExprGhcTc -- | The different source constructs that we use to instantiate the "original" field -- in an `XXExprGhcRn original expansion` data HsThingRn = OrigExpr (HsExpr GhcRn) - | OrigStmt (ExprLStmt GhcRn) HsDoFlavour + | OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from | OrigPat (LPat GhcRn) (Maybe (HsDoFlavour, ExprLStmt GhcRn)) isHsThingRnExpr, isHsThingRnStmt, isHsThingRnPat :: HsThingRn -> Bool @@ -1794,7 +1794,7 @@ pprArg (ApplicativeArgMany _ stmts return pat ctxt) = ppr pat <+> text "<-" <+> pprDo ctxt (stmts ++ - [noLocA (LastStmt noExtField (noLocA return) Nothing noSyntaxExpr)]) + [noLocA (LastStmt noExtField return Nothing noSyntaxExpr)]) pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -782,8 +782,8 @@ dsDo ctx stmts do_arg (ApplicativeArgOne fail_op pat expr _) = ((pat, fail_op), dsLExpr expr) - do_arg (ApplicativeArgMany _ stmts ret pat _) = - ((pat, Nothing), dsDo ctx (stmts ++ [noLocA $ mkLastStmt (noLocA ret)])) + do_arg (ApplicativeArgMany _ stmts ret@(L ret_loc _) pat _) = + ((pat, Nothing), dsDo ctx (stmts ++ [L ret_loc $ mkLastStmt ret])) ; rhss' <- sequence rhss ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -774,7 +774,7 @@ addTickApplicativeArg isGuard (op, arg) = addTickArg (ApplicativeArgMany x stmts ret pat ctxt) = (ApplicativeArgMany x) <$> addTickLStmts isGuard stmts - <*> (unLoc <$> addTickLHsExpr (L (noAnnSrcSpan hpcSrcSpan) ret)) + <*> addTickLHsExpr ret <*> addTickLPat pat <*> pure ctxt ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -2230,12 +2230,12 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do (stmts',fvs2) <- stmtTreeToStmts monad_names ctxt tree [] pvarset (mb_ret, fvs1) <- if | L _ ApplicativeStmt{} <- last stmts' -> - return (unLoc tup, emptyNameSet) + return (tup, emptyNameSet) | otherwise -> do -- Need 'pureAName' and not 'returnMName' here, so that it requires -- 'Applicative' and not 'Monad' whenever possible (until #20540 is fixed). (ret, _) <- lookupQualifiedDoExpr (HsDoStmt ctxt) pureAName - let expr = HsApp noExtField (noLocA ret) tup + let expr = noLocA (HsApp noExtField (noLocA ret) tup) return (expr, emptyFVs) return ( ApplicativeArgMany { xarg_app_arg_many = noExtField ===================================== compiler/GHC/Tc/Gen/Do.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Tc.Gen.Do (expandDoStmts) where import GHC.Prelude -import GHC.Rename.Utils ( wrapGenSpan, genHsExpApps, genHsApp, genHsLet, +import GHC.Rename.Utils ( wrapGenSpan, genHsExpApps, genHsApp, genHsLet, genLHsApp, genHsLamDoExp, genHsCaseAltDoExp, genWildPat ) import GHC.Tc.Utils.Monad import GHC.Tc.Gen.Pat @@ -88,9 +88,9 @@ expand_do_stmts flav [stmt@(L loc (LastStmt _ (L body_loc body) _ ret_expr))] -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt = do appDo <- xoptM LangExt.ApplicativeDo if appDo - then do traceTc "expand_do_stmts last no pop" (ppr ret_expr) + then do traceTc "expand_do_stmts last no pop" (ppr $ (L body_loc body)) return $ mkExpandedStmtAt loc stmt flav body - else do traceTc "expand_do_stmts last pop" (ppr ret_expr) + else do traceTc "expand_do_stmts last pop" (ppr $ (L body_loc body)) return $ mkExpandedStmtPopAt loc stmt flav body | SyntaxExprRn ret <- ret_expr @@ -191,17 +191,17 @@ expand_do_stmts doFlavour -- and potentially loop forever -expand_do_stmts doFlavour ((L loc (ApplicativeStmt _ args mb_join)): lstmts) = +expand_do_stmts doFlavour ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = -- See Note [Applicative BodyStmt] -- -- stmts ~~> stmts' -- ------------------------------------------------------------------------- --- [(<$>, \ x -> e1), (<*>, e2), (<*>, e3), .. ] ; stmts ~~> (\ x -> stmts') <$> e1 <*> e2 ... +-- [(fmap, \ x -> e1), (<*>, e2), (<*>, e3), .. ] ; stmts ~~> (\ x -> stmts') <$> e1 <*> e2 ... -- -- Very similar to HsToCore.Expr.dsDo -- args are [(<$>, e1), (<*>, e2), .., ] - do { expr' <- unLoc <$> expand_do_stmts doFlavour lstmts + do { expr' <- expand_do_stmts doFlavour lstmts -- extracts pats and arg bodies (rhss) from args ; (pats_can_fail, rhss) <- unzip <$> mapM (do_arg . snd) args @@ -213,9 +213,10 @@ expand_do_stmts doFlavour ((L loc (ApplicativeStmt _ args mb_join)): lstmts) = -- wrap the expanded expression with a `join` if needed ; let final_expr = case mb_join of - Just (SyntaxExprRn join_op) -> wrapGenSpan $ genHsApp join_op (wrapGenSpan expand_ado_expr) - _ -> L loc expand_ado_expr + Just (SyntaxExprRn join_op) -> genLHsApp join_op expand_ado_expr + _ -> expand_ado_expr ; traceTc "expand_do_stmts AppStmt" (vcat [ text "args:" <+> ppr args + , text "lstmts:" <+> ppr lstmts , text "mb_join:" <+> ppr mb_join , text "expansion:" <+> ppr final_expr]) ; return final_expr @@ -226,28 +227,34 @@ expand_do_stmts doFlavour ((L loc (ApplicativeStmt _ args mb_join)): lstmts) = { xarg_app_arg_one = mb_fail_op , app_arg_pattern = pat , arg_expr = (L rhs_loc rhs) + , is_body_stmt = is_body_stmt }) = - return ((pat, mb_fail_op) - , mkExpandedStmtAt rhs_loc (L rhs_loc (BindStmt xbsn pat (L rhs_loc rhs))) doFlavour rhs) - do_arg (ApplicativeArgMany _ stmts ret pat ctxt) = - do { expr <- expand_do_stmts ctxt $ stmts ++ [wrapGenSpan $ mkLastStmt (wrapGenSpan ret)] + do traceTc "do_arg" (text "OneArg" <+> ppr (L rhs_loc rhs)) + return ((pat, mb_fail_op) + , mkExpandedStmtAt rhs_loc stmt doFlavour rhs) + where stmt = if is_body_stmt + then (L rhs_loc (BodyStmt NoExtField (L rhs_loc rhs) NoSyntaxExprRn NoSyntaxExprRn)) + else (L rhs_loc (BindStmt xbsn pat (L rhs_loc rhs))) + do_arg (ApplicativeArgMany _ stmts ret@(L ret_loc _) pat ctxt) = + do { expr <- expand_do_stmts ctxt $ stmts ++ [L ret_loc $ mkLastStmt ret] ; return ((pat, Nothing) , expr) } - match_args :: ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) -> HsExpr GhcRn -> TcM (HsExpr GhcRn) - match_args ((pat, fail_op), stmt_expr) body = unLoc <$> mk_failable_expr doFlavour stmt_ctxt pat (wrapGenSpan body) fail_op + match_args :: ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) + match_args ((pat, fail_op), stmt_expr) body = mk_failable_expr doFlavour stmt_ctxt pat body fail_op where stmt_ctxt = case unLoc stmt_expr of XExpr (ExpandedThingRn (OrigStmt s _) _) -> Just (doFlavour, s) _ -> Nothing - mk_apps :: HsExpr GhcRn -> (SyntaxExprRn, LHsExpr GhcRn) -> HsExpr GhcRn + mk_apps :: LHsExpr GhcRn -> (SyntaxExprRn, LHsExpr GhcRn) -> LHsExpr GhcRn mk_apps l_expr (op, r_expr) = case op of SyntaxExprRn op -> case r_expr of - L _ (XExpr (ExpandedThingRn (OrigStmt (L l s) flav) e)) -> XExpr (ExpandedThingRn (OrigStmt (L l s) flav) - (genHsExpApps op [ wrapGenSpan l_expr - , wrapGenSpan e ])) - _ -> genHsExpApps op [ wrapGenSpan l_expr, r_expr ] + L loc (XExpr (ExpandedThingRn (OrigStmt (L l s) flav) e)) + -> L loc $ XExpr (ExpandedThingRn (OrigStmt (L l s) flav) + (genHsExpApps op [ l_expr + , L loc e ])) + _ -> wrapGenSpan $ genHsExpApps op [ l_expr, r_expr ] NoSyntaxExprRn -> pprPanic "expand_do_stmts applicative op:" (ppr op) xbsn :: XBindStmtRn ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1146,7 +1146,7 @@ tcApplicativeStmts ctxt pairs rhs_ty thing_inside = do { (stmts', (ret',pat')) <- tcStmtsAndThen (HsDoStmt ctxt) tcDoStmt stmts (mkCheckExpType exp_ty) $ \res_ty -> do - { ret' <- tcExpr ret res_ty + { ret' <- tcMonoExprNC ret res_ty ; (pat', _) <- tcCheckPat (StmtCtxt (HsDoStmt ctxt)) pat (unrestricted pat_ty) $ return () ; return (ret', pat') ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1453,7 +1453,7 @@ zonkStmt _zBody (ApplicativeStmt body_ty args mb_join) ; return (ApplicativeArgOne new_fail pat new_expr isBody) } zonk_arg (ApplicativeArgMany x stmts ret pat ctxt) = runZonkBndrT (zonkStmts zonkLExpr stmts) $ \ new_stmts -> - do { new_ret <- zonkExpr ret + do { new_ret <- zonkLExpr ret ; return (ApplicativeArgMany x new_stmts new_ret pat ctxt) } ------------------------------------------------------------------------- ===================================== compiler/Language/Haskell/Syntax/Expr.hs ===================================== @@ -1271,7 +1271,7 @@ data ApplicativeArg idL | ApplicativeArgMany -- do { stmts; return vars } { xarg_app_arg_many :: XApplicativeArgMany idL , app_stmts :: [ExprLStmt idL] -- stmts - , final_expr :: HsExpr idL -- return (v1,..,vn), or just (v1,..,vn) + , final_expr :: LHsExpr idL -- return (v1,..,vn), or just (v1,..,vn) , bv_pattern :: LPat idL -- (v1,...,vn) , stmt_context :: HsDoFlavour -- ^ context of the do expression, used in pprArg ===================================== testsuite/tests/ghci.debugger/scripts/break029.stdout ===================================== @@ -4,7 +4,7 @@ x :: Int = 3 Stopped in Main.f, break029.hs:5:8-21 _result :: IO Int = _ x :: Int = 3 -Stopped in Main.f, break029.hs:6:11-15 +Stopped in Main.f, break029.hs:6:3-16 _result :: Int = _ y :: Int = _ 4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f76e8cfdb0cb7780828257fab5990a404325dbee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f76e8cfdb0cb7780828257fab5990a404325dbee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 00:13:44 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 02 Apr 2024 20:13:44 -0400 Subject: [Git][ghc/ghc][master] th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Message-ID: <660c9f381197a_f9da4d8869c1079da@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - 1 changed file: - libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs Changes: ===================================== libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs ===================================== @@ -1,3 +1,4 @@ +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE Trustworthy #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/817e89362e74b5177c02deee31f16cec862052cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/817e89362e74b5177c02deee31f16cec862052cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 00:14:33 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 02 Apr 2024 20:14:33 -0400 Subject: [Git][ghc/ghc][master] 2 commits: JS: reenable h$appendToHsString optimization (#24495) Message-ID: <660c9f69b022e_f9da4f328e41128bc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - 9 changed files: - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Rts/Rts.hs - rts/js/string.js - + testsuite/tests/javascript/Makefile - + testsuite/tests/javascript/T24495.hs - + testsuite/tests/javascript/T24495.stdout - testsuite/tests/javascript/all.T Changes: ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -46,7 +46,6 @@ import GHC.StgToJS.Rts.Types import GHC.StgToJS.Stack import GHC.StgToJS.Ids -import GHC.Types.Literal import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.CostCentre @@ -60,7 +59,6 @@ import GHC.Core.TyCon import GHC.Core.DataCon import GHC.Core.Type hiding (typeSize) -import GHC.Utils.Encoding import GHC.Utils.Misc import GHC.Utils.Monad import GHC.Utils.Panic @@ -100,22 +98,6 @@ genApp -> G (JStgStat, ExprResult) genApp ctx i args - -- Case: unpackCStringAppend# "some string"# str - -- - -- Generates h$appendToHsStringA(str, "some string"), which has a faster - -- decoding loop. - | [StgLitArg (LitString bs), x] <- args - , [top] <- concatMap typex_expr (ctxTarget ctx) - , getUnique i == unpackCStringAppendIdKey - , d <- utf8DecodeByteString bs - = do - prof <- csProf <$> getSettings - let profArg = if prof then [jCafCCS] else [] - a <- genArg x - return ( top |= app "h$appendToHsStringA" (toJExpr d : a ++ profArg) - , ExprInline - ) - -- let-no-escape | Just n <- ctxLneBindingStackSize ctx i = do ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -60,11 +60,13 @@ import GHC.Types.Var.Set import GHC.Types.Id import GHC.Types.Unique.FM import GHC.Types.RepType +import GHC.Types.Literal import GHC.Stg.Syntax import GHC.Stg.Utils import GHC.Builtin.PrimOps +import GHC.Builtin.Names import GHC.Core hiding (Var) import GHC.Core.TyCon @@ -73,6 +75,7 @@ import GHC.Core.Opt.Arity (isOneShotBndr) import GHC.Core.Type hiding (typeSize) import GHC.Utils.Misc +import GHC.Utils.Encoding import GHC.Utils.Monad import GHC.Utils.Panic import GHC.Utils.Outputable (ppr, renderWithContext, defaultSDocContext) @@ -555,6 +558,36 @@ genCase :: HasDebugCallStack -> LiveVars -> G (JStgStat, ExprResult) genCase ctx bnd e at alts l + -- For: unpackCStringAppend# "some string"# str + -- Generate: h$appendToHsStringA(str, "some string") + -- + -- The latter has a faster decoding loop. + -- + -- Since #23270 and 7e0c8b3bab30, literals strings aren't STG atoms and we + -- need to match the following instead: + -- + -- case "some string"# of b { + -- DEFAULT -> unpackCStringAppend# b str + -- } + -- + -- Wrinkle: it doesn't kick in when literals are floated out to the top level. + -- + | StgLit (LitString bs) <- e + , [GenStgAlt DEFAULT _ rhs] <- alts + , StgApp i args <- rhs + , getUnique i == unpackCStringAppendIdKey + , [StgVarArg b',x] <- args + , bnd == b' + , d <- utf8DecodeByteString bs + , [top] <- concatMap typex_expr (ctxTarget ctx) + = do + prof <- csProf <$> getSettings + let profArg = if prof then [jCafCCS] else [] + a <- genArg x + return ( top |= app "h$appendToHsStringA" (toJExpr d : a ++ profArg) + , ExprInline + ) + | isInlineExpr e = do bndi <- identsForId bnd let ctx' = ctxSetTop bnd ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -191,6 +191,9 @@ genCommonCppDefs profiling = mconcat -- resumable thunks , "#define MAKE_RESUMABLE(closure,stack) { (closure).f = h$resume_e; (closure).d1 = (stack), (closure).d2 = null; }\n" + -- making a thunk + , "#define MK_UPD_THUNK(closure) h$c1(h$upd_thunk_e,(closure))\n" + -- general deconstruction , "#define IS_THUNK(x) ((x).f.t === CLOSURE_TYPE_THUNK)\n" , "#define CONSTR_TAG(x) ((x).f.a)\n" ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -448,6 +448,19 @@ rts_gen s = do , r4 |= d4 , returnS (app "h$ap_3_3_fast" []) ]) + , closure (ClosureInfo (TxtI "h$upd_thunk_e") (CIRegs 0 [PtrV]) "updatable thunk" (CILayoutFixed 1 [PtrV]) CIThunk mempty) + (jVar $ \t -> return $ + mconcat [t |= closureField1 r1 + , adjSp' 2 + , stack .! (sp - 1) |= r1 + , stack .! sp |= var "h$upd_frame" + , closureEntry r1 |= var "h$blackhole" + , closureField1 r1 |= var "h$currentThread" + , closureField2 r1 |= null_ + , r1 |= t + , returnS (app "h$ap_0_0_fast" []) + ] + ) -- select first field , closure (ClosureInfo (global "h$select1_e") (CIRegs 0 [PtrV]) "select1" (CILayoutFixed 1 [PtrV]) CIThunk mempty) (jVar \t -> return $ ===================================== rts/js/string.js ===================================== @@ -723,7 +723,10 @@ function h$appendToHsStringA(str, appendTo, cc) { function h$appendToHsStringA(str, appendTo) { #endif var i = str.length - 1; - var r = appendTo; + // we need to make an updatable thunk here + // if we embed the given closure in a CONS cell. + // (#24495) + var r = i == 0 ? appendTo : MK_UPD_THUNK(appendTo); while(i>=0) { r = MK_CONS_CC(str.charCodeAt(i), r, cc); --i; ===================================== testsuite/tests/javascript/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T24495: + '$(TEST_HC)' $(TEST_HC_OPTS) T24495.hs -v0 -O1 -dsuppress-uniques -ddump-js -ddump-to-file + ./T24495 + # check that the optimization occurred + grep -c appendToHsStringA T24495.dump-js ===================================== testsuite/tests/javascript/T24495.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE MagicHash #-} +{-# OPTIONS_GHC -O1 #-} +-- -O1 required to make "rest" thunk SingleEntry + +module Main where + +import GHC.CString +import GHC.JS.Prim (JSVal, toJSString) + +foo :: Double -> IO () +foo x = debugString (toJSString ("2 " ++ s)) + where + x' = if x == 0 then "b" else "c" + y' = if x == 0 then "b" else "c" + s = "a" ++ x' ++ " " ++ y' ++ "d" + +main :: IO () +main = foo 0 + + +foreign import javascript "((s) => { console.log(s); })" + debugString :: JSVal -> IO () ===================================== testsuite/tests/javascript/T24495.stdout ===================================== @@ -0,0 +1,2 @@ +2 ab bd +2 ===================================== testsuite/tests/javascript/all.T ===================================== @@ -21,3 +21,4 @@ test('js-mk_tup', extra_files(['test-mk_tup.js']), compile_and_run, ['test-mk_tu test('T23346', normal, compile_and_run, ['']) test('T22455', normal, compile_and_run, ['-ddisable-js-minifier']) test('T23565', normal, compile_and_run, ['']) +test('T24495', normal, makefile_test, ['T24495']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/817e89362e74b5177c02deee31f16cec862052cc...527616e950fd8942c182be903d176f4b9890ee5a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/817e89362e74b5177c02deee31f16cec862052cc...527616e950fd8942c182be903d176f4b9890ee5a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 00:15:45 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 02 Apr 2024 20:15:45 -0400 Subject: [Git][ghc/ghc][master] Deal with duplicate tyvars in type declarations Message-ID: <660c9fb13e7db_f9da5179af8121168@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - 14 changed files: - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/saks/should_compile/saks018.hs - testsuite/tests/saks/should_compile/saks021.hs - testsuite/tests/saks/should_fail/all.T - + testsuite/tests/saks/should_fail/saks018-fail.hs - + testsuite/tests/saks/should_fail/saks018-fail.stderr - + testsuite/tests/saks/should_fail/saks021-fail.hs - + testsuite/tests/saks/should_fail/saks021-fail.stderr - testsuite/tests/typecheck/should_compile/T24470b.hs - + testsuite/tests/vdq-rta/should_fail/T24604.hs - + testsuite/tests/vdq-rta/should_fail/T24604.stderr - + testsuite/tests/vdq-rta/should_fail/T24604a.hs - + testsuite/tests/vdq-rta/should_fail/T24604a.stderr - testsuite/tests/vdq-rta/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2570,9 +2570,11 @@ kcCheckDeclHeader_sig sig_kind name flav ; traceTc "kcCheckDeclHeader_sig {" $ vcat [ text "sig_kind:" <+> ppr sig_kind , text "sig_tcbs:" <+> ppr sig_tcbs - , text "sig_res_kind:" <+> ppr sig_res_kind ] + , text "sig_res_kind:" <+> ppr sig_res_kind + , text "implict_nms:" <+> ppr implicit_nms + , text "hs_tv_bndrs:" <+> ppr hs_tv_bndrs ] - ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, (extra_tcbs, tycon_res_kind)))) + ; (tclvl, wanted, (implicit_tvs, (skol_tcbs, skol_scoped_tvs, (extra_tcbs, tycon_res_kind)))) <- pushLevelAndSolveEqualitiesX "kcCheckDeclHeader_sig" $ -- #16687 bindImplicitTKBndrs_Q_Tv implicit_nms $ -- Q means don't clone matchUpSigWithDecl name sig_tcbs sig_res_kind hs_tv_bndrs $ \ excess_sig_tcbs sig_res_kind -> @@ -2615,9 +2617,18 @@ kcCheckDeclHeader_sig sig_kind name flav -- Here p and q both map to the same kind variable k. We don't allow this -- so we must check that they are distinct. A similar thing happens -- in GHC.Tc.TyCl.swizzleTcTyConBinders during inference. + -- + -- With visible dependent quantification, one of the binders involved + -- may be explicit. Consider #24604 + -- type UF :: forall zk -> zk -> Constraint + -- class UF kk (xb :: k) + -- Here `k` and `kk` both denote the same variable; but only `k` is implicit + -- Hence we need to add skol_scoped_tvs ; implicit_tvs <- liftZonkM $ zonkTcTyVarsToTcTyVars implicit_tvs ; let implicit_prs = implicit_nms `zip` implicit_tvs - ; checkForDuplicateScopedTyVars implicit_prs + dup_chk_prs = implicit_prs ++ mkTyVarNamePairs skol_scoped_tvs + ; unless (null implicit_nms) $ -- No need if no implicit tyvars + checkForDuplicateScopedTyVars dup_chk_prs ; checkForDisconnectedScopedTyVars name flav all_tcbs implicit_prs -- Swizzle the Names so that the TyCon uses the user-declared implicit names @@ -2686,6 +2697,7 @@ matchUpSigWithDecl -> ([TcTyConBinder] -> TcKind -> TcM a) -- All user-written binders are in scope -- Argument is excess TyConBinders and tail kind -> TcM ( [TcTyConBinder] -- Skolemised binders, with TcTyVars + , [TcTyVar] -- Skolem tyvars brought into lexical scope by this matching-up , a ) -- See Note [Matching a kind signature with a declaration] -- Invariant: Length of returned TyConBinders + length of excess TyConBinders @@ -2696,7 +2708,7 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside go subst tcbs [] = do { let (subst', tcbs') = substTyConBindersX subst tcbs ; res <- thing_inside tcbs' (substTy subst' sig_res_kind) - ; return ([], res) } + ; return ([], [], res) } go _ [] hs_bndrs = failWithTc (TcRnTooManyBinders sig_res_kind hs_bndrs) @@ -2712,17 +2724,22 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside -- that come from the type declaration, not the kind signature subst' = extendTCvSubstWithClone subst tv tv' ; tc_hs_bndr (unLoc hs_bndr) (tyVarKind tv') - ; (tcbs', res) <- tcExtendTyVarEnv [tv'] $ - go subst' tcbs' hs_bndrs' - ; return (Bndr tv' vis : tcbs', res) } + ; traceTc "musd1" (ppr tcb $$ ppr hs_bndr $$ ppr tv') + ; (tcbs', tvs, res) <- tcExtendTyVarEnv [tv'] $ + go subst' tcbs' hs_bndrs' + ; return (Bndr tv' vis : tcbs', tv':tvs, res) } + -- We do a tcExtendTyVarEnv [tv'], so we return tv' in + -- the list of lexically-scoped skolem type variables | skippable (binderFlag tcb) = -- Invisible TyConBinder, so do not consume one of the hs_bndrs do { let (subst', tcb') = substTyConBinderX subst tcb - ; (tcbs', res) <- go subst' tcbs' hs_bndrs + ; traceTc "musd2" (ppr tcb $$ ppr hs_bndr $$ ppr tcb') + ; (tcbs', tvs, res) <- go subst' tcbs' hs_bndrs -- NB: pass on hs_bndrs unchanged; we do not consume a -- HsTyVarBndr for an invisible TyConBinder - ; return (tcb' : tcbs', res) } + ; return (tcb' : tcbs', tvs, res) } + -- Return `tvs`; no new lexically-scoped TyVars brought into scope | otherwise = -- At this point we conclude that: @@ -2736,14 +2753,19 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside = return () tc_hs_bndr (KindedTyVar _ _ (L _ hs_nm) lhs_kind) expected_kind = do { sig_kind <- tcLHsKindSig (TyVarBndrKindCtxt hs_nm) lhs_kind + ; traceTc "musd3:unifying" (ppr sig_kind $$ ppr expected_kind) ; discardResult $ -- See Note [discardResult in kcCheckDeclHeader_sig] unifyKind (Just (NameThing hs_nm)) sig_kind expected_kind } -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. + -- In particular: we match up if + -- (a) HsBndr looks like @k, and TyCon binder is forall k. (NamedTCB Specified) + -- (b) HsBndr looks like a, and TyCon binder is forall k -> (NamedTCB Required) + -- or k -> (AnonTCB) zippable :: TyConBndrVis -> HsBndrVis GhcRn -> Bool - zippable vis (HsBndrRequired _) = isVisibleTcbVis vis - zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis + zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis -- (a) + zippable vis (HsBndrRequired _) = isVisibleTcbVis vis -- (b) -- See GHC Proposal #425, section "Kind checking", -- where zippable and skippable are defined. @@ -3007,15 +3029,7 @@ checkForDisconnectedScopedTyVars name flav all_tcbs scoped_prs checkForDuplicateScopedTyVars :: [(Name,TcTyVar)] -> TcM () -- Check for duplicates --- E.g. data SameKind (a::k) (b::k) --- data T (a::k1) (b::k2) c = MkT (SameKind a b) c --- Here k1 and k2 start as TyVarTvs, and get unified with each other --- If this happens, things get very confused later, so fail fast --- --- In the CUSK case k1 and k2 are skolems so they won't unify; --- but in the inference case (see generaliseTcTyCon), --- and the type-sig case (see kcCheckDeclHeader_sig), they are --- TcTyVars, so we must check. +-- See Note [Aliasing in type and class declarations] checkForDuplicateScopedTyVars scoped_prs = unless (null err_prs) $ do { mapM_ report_dup err_prs; failM } @@ -3035,8 +3049,43 @@ checkForDuplicateScopedTyVars scoped_prs addErrTc $ TcRnDifferentNamesForTyVar n1 n2 -{- Note [Disconnected type variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Aliasing in type and class declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data SameKind (a::k) (b::k) + data T1 (a::k1) (b::k2) c = MkT (SameKind a b) c +We do not allow this, because `k1` and `k2` would both stand for the same type +variable -- they are both aliases for `k`. + +Other examples + data T2 (a::k1) = MkT2 (SameKind a Int) -- k1 stands for Type + data T3 @k1 @k2 (a::k1) (b::k2) = MkT (SameKind a b) -- k1 and k2 are aliases + + type UF :: forall zk. zk -> Constraint + class UF @kk (xb :: k) where -- kk and k are aliases + op :: (xs::kk) -> Bool + +See #24604 for an example that crashed GHC. + +There is a design choice here. It would be possible to allow implicit type variables +like `k1` and `k2` in T1's declartion to stand for /abitrary kinds/. This is in fact +the rule we use in /terms/ pattern signatures: + f :: [Int] -> Int + f ((x::a) : xs) = ... +Here `a` stands for `Int`. But in type /signatures/ we make a different choice: + f1 :: forall (a::k1) (b::k2). SameKind a b -> blah + f2 :: forall (a::k). SameKind a Int -> blah + +Here f1's signature is rejected because `k1` and `k2` are aliased; and f2's is +rejected because `k` stands for `Int`. + +Our current choice is that type and class declarations behave more like signatures; +we do not allow aliasing. That is what `checkForDuplicateScopedTyVars` checks. +See !12328 for some design discussion. + + +Note [Disconnected type variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This note applies when kind-checking the header of a type/class decl that has a separate, standalone kind signature. See #24083. ===================================== testsuite/tests/saks/should_compile/saks018.hs ===================================== @@ -6,4 +6,4 @@ module SAKS_018 where import Data.Kind (Type) type T :: forall k -> k -> Type -data T k (x :: hk) +data T j (x :: j) ===================================== testsuite/tests/saks/should_compile/saks021.hs ===================================== @@ -6,4 +6,4 @@ module SAKS_021 where import Data.Kind (Type) type T :: forall k -> forall (xx :: k) -> Type -data T k (x :: hk) +data T j (x :: j) ===================================== testsuite/tests/saks/should_fail/all.T ===================================== @@ -36,3 +36,5 @@ test('T18863b', normal, compile_fail, ['']) test('T18863c', normal, compile_fail, ['']) test('T18863d', normal, compile_fail, ['']) test('T20916', normal, compile_fail, ['']) +test('saks018-fail', normal, compile_fail, ['']) +test('saks021-fail', normal, compile_fail, ['']) ===================================== testsuite/tests/saks/should_fail/saks018-fail.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE PolyKinds, ExplicitForAll #-} + +module SAKS_018 where + +import Data.Kind (Type) + +type T :: forall k -> k -> Type +data T k (x :: hk) ===================================== testsuite/tests/saks/should_fail/saks018-fail.stderr ===================================== @@ -0,0 +1,4 @@ + +saks018-fail.hs:9:8: error: [GHC-17370] + • Different names for the same type variable: ‘hk’ and ‘k’ + • In the data type declaration for ‘T’ ===================================== testsuite/tests/saks/should_fail/saks021-fail.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE PolyKinds, ExplicitForAll #-} + +module SAKS_021 where + +import Data.Kind (Type) + +type T :: forall k -> forall (xx :: k) -> Type +data T k (x :: hk) ===================================== testsuite/tests/saks/should_fail/saks021-fail.stderr ===================================== @@ -0,0 +1,4 @@ + +saks021-fail.hs:9:8: error: [GHC-17370] + • Different names for the same type variable: ‘hk’ and ‘k’ + • In the data type declaration for ‘T’ ===================================== testsuite/tests/typecheck/should_compile/T24470b.hs ===================================== @@ -7,4 +7,4 @@ import Data.Kind import Data.Data type SynOK :: forall k. k -> Type -type SynOK @t = Proxy :: j -> Type +type SynOK @j = Proxy :: j -> Type ===================================== testsuite/tests/vdq-rta/should_fail/T24604.hs ===================================== @@ -0,0 +1,7 @@ +module T24604 where + +import Data.Kind + +type UF :: forall zk -> zk -> Constraint +class UF kk (xb :: k) where + op :: (xs::kk) -> Bool ===================================== testsuite/tests/vdq-rta/should_fail/T24604.stderr ===================================== @@ -0,0 +1,4 @@ + +T24604.hs:6:10: error: [GHC-17370] + • Different names for the same type variable: ‘k’ and ‘kk’ + • In the class declaration for ‘UF’ ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeAbstractions #-} + +module T24604a where + +import Data.Kind + +type UF :: forall zk. zk -> Constraint +class UF @kk (xb :: k) where + op :: (xs::kk) -> Bool ===================================== testsuite/tests/vdq-rta/should_fail/T24604a.stderr ===================================== @@ -0,0 +1,4 @@ + +T24604a.hs:8:11: error: [GHC-17370] + • Different names for the same type variable: ‘k’ and ‘kk’ + • In the class declaration for ‘UF’ ===================================== testsuite/tests/vdq-rta/should_fail/all.T ===================================== @@ -17,4 +17,6 @@ test('T23738_fail_implicit_tv', normal, compile_fail, ['']) test('T23738_fail_var', normal, compile_fail, ['']) test('T24176', normal, compile_fail, ['']) test('T23739_fail_ret', normal, compile_fail, ['']) -test('T23739_fail_case', normal, compile_fail, ['']) \ No newline at end of file +test('T23739_fail_case', normal, compile_fail, ['']) +test('T24604', normal, compile_fail, ['']) +test('T24604a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/faa30b41a6f941627ddeeba805815b2742d312d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/faa30b41a6f941627ddeeba805815b2742d312d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 00:16:10 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 02 Apr 2024 20:16:10 -0400 Subject: [Git][ghc/ghc][master] Try using MCoercion in exprIsConApp_maybe Message-ID: <660c9fca59232_f9da52b8b94121395@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 2 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/SimpleOpt.hs Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3023,7 +3023,7 @@ pushCoercionIntoLambda in_scope x e co | otherwise = Nothing -pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion +pushCoDataCon :: DataCon -> [CoreExpr] -> MCoercion -> Maybe (DataCon , [Type] -- Universal type args , [CoreExpr]) -- All other args incl existentials @@ -3033,10 +3033,20 @@ pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion -- where co :: (T t1 .. tn) ~ to_ty -- The left-hand one must be a T, because exprIsConApp returned True -- but the right-hand one might not be. (Though it usually will.) -pushCoDataCon dc dc_args co - | isReflCo co || from_ty `eqType` to_ty -- try cheap test first - , let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args - = Just (dc, map exprToType univ_ty_args, rest_args) +pushCoDataCon dc dc_args MRefl = Just $! (push_dc_refl dc dc_args) +pushCoDataCon dc dc_args (MCo co) = push_dc_gen dc dc_args co (coercionKind co) + +push_dc_refl :: DataCon -> [CoreExpr] -> (DataCon, [Type], [CoreExpr]) +push_dc_refl dc dc_args + = (dc, map exprToType univ_ty_args, rest_args) + where + !(univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args + +push_dc_gen :: DataCon -> [CoreExpr] -> Coercion -> Pair Type + -> Maybe (DataCon, [Type], [CoreExpr]) +push_dc_gen dc dc_args co (Pair from_ty to_ty) + | from_ty `eqType` to_ty -- try cheap test first + = Just $! (push_dc_refl dc dc_args) | Just (to_tc, to_tc_arg_tys) <- splitTyConApp_maybe to_ty , to_tc == dataConTyCon dc @@ -3082,8 +3092,6 @@ pushCoDataCon dc dc_args co | otherwise = Nothing - where - Pair from_ty to_ty = coercionKind co collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr) -- Collect lambda binders, pushing coercions inside if possible ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -1211,7 +1211,7 @@ data-con wrappers, and that cure would be worse than the disease. This Note exists solely to document the problem. -} -data ConCont = CC [CoreExpr] Coercion +data ConCont = CC [CoreExpr] MCoercion -- Substitution already applied -- | Returns @Just ([b1..bp], dc, [t1..tk], [x1..xn])@ if the argument @@ -1233,7 +1233,7 @@ exprIsConApp_maybe :: HasDebugCallStack => InScopeEnv -> CoreExpr -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr]) exprIsConApp_maybe ise@(ISE in_scope id_unf) expr - = go (Left in_scope) [] expr (CC [] (mkRepReflCo (exprType expr))) + = go (Left in_scope) [] expr (CC [] MRefl) where go :: Either InScopeSet Subst -- Left in-scope means "empty substitution" @@ -1246,14 +1246,12 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr go subst floats (Tick t expr) cont | not (tickishIsCode t) = go subst floats expr cont - go subst floats (Cast expr co1) (CC args co2) + go subst floats (Cast expr co1) (CC args m_co2) | Just (args', m_co1') <- pushCoArgs (subst_co subst co1) args -- See Note [Push coercions in exprIsConApp_maybe] - = case m_co1' of - MCo co1' -> go subst floats expr (CC args' (co1' `mkTransCo` co2)) - MRefl -> go subst floats expr (CC args' co2) + = go subst floats expr (CC args' (m_co1' `mkTransMCo` m_co2)) - go subst floats (App fun arg) (CC args co) + go subst floats (App fun arg) (CC args mco) | let arg_type = exprType arg , not (isTypeArg arg) && needsCaseBinding arg_type arg -- An unlifted argument that’s not ok for speculation must not simply be @@ -1276,17 +1274,17 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr bndr = uniqAway (subst_in_scope subst) (mkWildValBinder ManyTy arg_type) float = FloatCase arg' bndr DEFAULT [] subst' = subst_extend_in_scope subst bndr - in go subst' (float:floats) fun (CC (Var bndr : args) co) + in go subst' (float:floats) fun (CC (Var bndr : args) mco) | otherwise - = go subst floats fun (CC (subst_expr subst arg : args) co) + = go subst floats fun (CC (subst_expr subst arg : args) mco) - go subst floats (Lam bndr body) (CC (arg:args) co) + go subst floats (Lam bndr body) (CC (arg:args) mco) | do_beta_by_substitution bndr arg - = go (extend subst bndr arg) floats body (CC args co) + = go (extend subst bndr arg) floats body (CC args mco) | otherwise = let (subst', bndr') = subst_bndr subst bndr float = FloatLet (NonRec bndr' arg) - in go subst' (float:floats) body (CC args co) + in go subst' (float:floats) body (CC args mco) go subst floats (Let (NonRec bndr rhs) expr) cont | not (isJoinId bndr) @@ -1311,12 +1309,12 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr (lookupIdSubst sub v) cont - go (Left in_scope) floats (Var fun) cont@(CC args co) + go (Left in_scope) floats (Var fun) cont@(CC args mco) | Just con <- isDataConWorkId_maybe fun , count isValArg args == idArity fun = succeedWith in_scope floats $ - pushCoDataCon con args co + pushCoDataCon con args mco -- Look through data constructor wrappers: they inline late (See Note -- [Activation for data constructor wrappers]) but we want to do @@ -1336,7 +1334,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- simplOptExpr initialises the in-scope set with exprFreeVars, -- but that doesn't account for DFun unfoldings = succeedWith in_scope floats $ - pushCoDataCon con (map (substExpr subst) dfun_args) co + pushCoDataCon con (map (substExpr subst) dfun_args) mco -- Look through unfoldings, but only arity-zero one; -- if arity > 0 we are effectively inlining a function call, @@ -1354,7 +1352,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr , [arg] <- args , Just (LitString str) <- exprIsLiteral_maybe ise arg = succeedWith in_scope floats $ - dealWithStringLiteral fun str co + dealWithStringLiteral fun str mco where unfolding = id_unf fun extend_in_scope unf_fvs @@ -1404,15 +1402,15 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- See Note [exprIsConApp_maybe on literal strings] -dealWithStringLiteral :: Var -> BS.ByteString -> Coercion +dealWithStringLiteral :: Var -> BS.ByteString -> MCoercion -> Maybe (DataCon, [Type], [CoreExpr]) -- This is not possible with user-supplied empty literals, GHC.Core.Make.mkStringExprFS -- turns those into [] automatically, but just in case something else in GHC -- generates a string literal directly. -dealWithStringLiteral fun str co = +dealWithStringLiteral fun str mco = case utf8UnconsByteString str of - Nothing -> pushCoDataCon nilDataCon [Type charTy] co + Nothing -> pushCoDataCon nilDataCon [Type charTy] mco Just (char, charTail) -> let char_expr = mkConApp charDataCon [mkCharLit char] -- In singleton strings, just add [] instead of unpackCstring# ""#. @@ -1421,7 +1419,7 @@ dealWithStringLiteral fun str co = else App (Var fun) (Lit (LitString charTail)) - in pushCoDataCon consDataCon [Type charTy, char_expr, rest] co + in pushCoDataCon consDataCon [Type charTy, char_expr, rest] mco {- Note [Unfolding DFuns] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0b0c71716e700d3fb5fc2aec8c14ac588f60636 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0b0c71716e700d3fb5fc2aec8c14ac588f60636 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 02:17:16 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 02 Apr 2024 22:17:16 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 43 commits: th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Message-ID: <660cbc2c59760_f9da60e53841280b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 5c8e7c14 by Duncan Coutts at 2024-04-02T22:17:04-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 3e7ba020 by Duncan Coutts at 2024-04-02T22:17:04-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - e9f09f3e by Duncan Coutts at 2024-04-02T22:17:04-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - e02025fa by Duncan Coutts at 2024-04-02T22:17:04-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - a6432a0a by Duncan Coutts at 2024-04-02T22:17:04-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - dd62b661 by Duncan Coutts at 2024-04-02T22:17:04-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 67f72a0c by Duncan Coutts at 2024-04-02T22:17:04-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - bf4b90b9 by Duncan Coutts at 2024-04-02T22:17:05-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - a82d71c7 by Duncan Coutts at 2024-04-02T22:17:05-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - 32bba262 by Duncan Coutts at 2024-04-02T22:17:05-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - 50dc8e81 by Duncan Coutts at 2024-04-02T22:17:05-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - c9940d85 by Duncan Coutts at 2024-04-02T22:17:05-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 6b9cfb49 by Duncan Coutts at 2024-04-02T22:17:05-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 7a622337 by Duncan Coutts at 2024-04-02T22:17:05-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - 20ac84f6 by Duncan Coutts at 2024-04-02T22:17:05-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 960f33c5 by Duncan Coutts at 2024-04-02T22:17:05-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - a6efa561 by Duncan Coutts at 2024-04-02T22:17:05-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - a103818d by Duncan Coutts at 2024-04-02T22:17:05-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - 0ccb581f by Duncan Coutts at 2024-04-02T22:17:05-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 1f26d687 by Duncan Coutts at 2024-04-02T22:17:05-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 0e0c825f by Duncan Coutts at 2024-04-02T22:17:05-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 27d0bf61 by Duncan Coutts at 2024-04-02T22:17:05-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - df6c03ec by Duncan Coutts at 2024-04-02T22:17:05-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 91004efb by Duncan Coutts at 2024-04-02T22:17:05-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 139e2c9e by Duncan Coutts at 2024-04-02T22:17:05-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - b65f6118 by Duncan Coutts at 2024-04-02T22:17:05-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - 90d6aea7 by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - c0efce1f by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 3b9a1de8 by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 2d065c65 by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 Spelling, layout, pretty-printing only - - - - - 7f10d2db by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - dc1dd17d by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - af2df69f by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - af30fae8 by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - 23738641 by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 Remove a long-commented-out line Pure refactoring - - - - - 7389f48b by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 08e36400 by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 Testsuite message changes from simplifier improvements - - - - - 944ef992 by Simon Peyton Jones at 2024-04-02T22:17:06-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 14 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3dffa74229386b4a9a8d4c0de2bee084bc53e0ac...944ef9924c37b108174b8ed1006112dde4e7cc28 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3dffa74229386b4a9a8d4c0de2bee084bc53e0ac...944ef9924c37b108174b8ed1006112dde4e7cc28 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 05:27:52 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 Apr 2024 01:27:52 -0400 Subject: [Git][ghc/ghc][master] 26 commits: Initial ./configure support for selecting I/O managers Message-ID: <660ce8d8711c3_2ed9481567998110098@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - 30 changed files: - docs/users_guide/runtime_control.rst - libraries/base/src/GHC/RTS/Flags.hs - libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - + m4/ghc_iomanagers.m4 - rts/Capability.c - rts/Capability.h - rts/IOManager.c - rts/IOManager.h - + rts/IOManagerInternals.h - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsFlags.c - rts/RtsFlags.h - rts/RtsStartup.c - rts/RtsSymbols.c - rts/RtsUtils.c - rts/Schedule.c - rts/Trace.h - rts/configure.ac - rts/include/rts/Flags.h - rts/posix/Select.c - rts/posix/Select.h - rts/posix/Signals.c - rts/sm/Scav.c - rts/win32/AsyncMIO.c - rts/win32/AwaitEvent.c - + rts/win32/AwaitEvent.h - rts/win32/ConsoleHandler.c - testsuite/tests/interface-stability/base-exports.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e0b0c71716e700d3fb5fc2aec8c14ac588f60636...8d95096857dbea39b80befacab35182e0f64ae62 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e0b0c71716e700d3fb5fc2aec8c14ac588f60636...8d95096857dbea39b80befacab35182e0f64ae62 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 05:28:42 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 Apr 2024 01:28:42 -0400 Subject: [Git][ghc/ghc][master] 12 commits: Several improvements to the handling of coercions Message-ID: <660ce90a5f0cc_2ed948175d7201192ac@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 14 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d95096857dbea39b80befacab35182e0f64ae62...271a7812cbb47494c74b1dc3b7d2a26fd8d88365 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d95096857dbea39b80befacab35182e0f64ae62...271a7812cbb47494c74b1dc3b7d2a26fd8d88365 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 05:53:54 2024 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 03 Apr 2024 01:53:54 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/invis-pats-change-ast] 54 commits: EPA: Fix FamDecl range Message-ID: <660ceef28ae2b_2ed9481ac3bf811941e@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/invis-pats-change-ast at Glasgow Haskell Compiler / GHC Commits: cd0fb82f by Alan Zimmerman at 2024-03-27T19:33:08+00:00 EPA: Fix FamDecl range The span was incorrect if opt_datafam_kind_sig was empty - - - - - f8f384a8 by Ben Gamari at 2024-03-29T01:23:03-04:00 Fix type of _get_osfhandle foreign import Fixes #24601. - - - - - 00d3ecf0 by Alan Zimmerman at 2024-03-29T12:19:10+00:00 EPA: Extend StringLiteral range to include trailing commas This goes slightly against the exact printing philosophy where trailing decorations should be in an annotation, but the practicalities of adding it to the WarningTxt environment, and the problems caused by deviating do not make a more principles approach worthwhile. - - - - - efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 8fbc07b8 by Andrei Borzenkov at 2024-04-03T09:53:39+04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 16 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/64339f17846405e046f8c6d241ef1a2887ffe37d...8fbc07b8ac00a88fd704f6d91ed4a25f7689e448 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/64339f17846405e046f8c6d241ef1a2887ffe37d...8fbc07b8ac00a88fd704f6d91ed4a25f7689e448 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 07:02:48 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Wed, 03 Apr 2024 03:02:48 -0400 Subject: [Git][ghc/ghc][wip/fendor/os-string-modlocation] Migrate `Finder` component to `OsPath` Message-ID: <660cff1854a84_2ed94822dab0c124861@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/os-string-modlocation at Glasgow Haskell Compiler / GHC Commits: 6c1cd800 by Fendor at 2024-04-03T09:02:29+02:00 Migrate `Finder` component to `OsPath` For each module in a GHCi session, we keep alive one `ModLocation`. A `ModLocation` is fairly inefficiently packed, as `String`s are expensive in memory usage. While benchmarking the agda codebase, we concluded that we keep alive around 11MB of `FilePath`'s, solely retained by `ModLocation`. We provide a more densely packed encoding of `ModLocation`, by moving from `FilePath` to `OsPath`. Further, we migrate the full `Finder` component to `OsPath` to avoid unnecessary transformations. As the `Finder` component is well-encapsuled, this requires only a minimal amount of changes in other modules. Bump to haddock submodule for `ModLocation` changes. - - - - - 16 changed files: - compiler/GHC.hs - + compiler/GHC/Data/OsPath.hs - compiler/GHC/Data/Strict.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Location.hs - compiler/ghc.cabal.in - utils/haddock Changes: ===================================== compiler/GHC.hs ===================================== @@ -76,6 +76,12 @@ module GHC ( ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries, mgLookupModule, ModSummary(..), ms_mod_name, ModLocation(..), + ml_hs_file, + ml_hi_file, + ml_dyn_hi_file, + ml_obj_file, + ml_dyn_obj_file, + ml_hie_file, getModSummary, getModuleGraph, isLoaded, ===================================== compiler/GHC/Data/OsPath.hs ===================================== @@ -0,0 +1,19 @@ +module GHC.Data.OsPath + ( + -- * OsPath initialisation and transformation + OsPath + , unsafeDecodeUtf + , unsafeEncodeUtf + -- * Common utility functions + , () + , (<.>) + ) + where + +import GHC.Prelude + +import System.OsPath +import Data.Either + +unsafeDecodeUtf :: OsPath -> FilePath +unsafeDecodeUtf = fromRight (error "unsafeEncodeUtf: Internal error") . decodeUtf ===================================== compiler/GHC/Data/Strict.hs ===================================== @@ -9,8 +9,11 @@ module GHC.Data.Strict ( Maybe(Nothing, Just), fromMaybe, + GHC.Data.Strict.maybe, Pair(And), - + expectJust, + fromLazy, + toLazy, -- Not used at the moment: -- -- Either(Left, Right), @@ -18,9 +21,12 @@ module GHC.Data.Strict ( ) where import GHC.Prelude hiding (Maybe(..), Either(..)) +import GHC.Stack.Types + import Control.Applicative import Data.Semigroup import Data.Data +import qualified Data.Maybe as Lazy data Maybe a = Nothing | Just !a deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data) @@ -29,6 +35,10 @@ fromMaybe :: a -> Maybe a -> a fromMaybe d Nothing = d fromMaybe _ (Just x) = x +maybe :: b -> (a -> b) -> Maybe a -> b +maybe d _ Nothing = d +maybe _ f (Just x) = f x + apMaybe :: Maybe (a -> b) -> Maybe a -> Maybe b apMaybe (Just f) (Just x) = Just (f x) apMaybe _ _ = Nothing @@ -37,6 +47,19 @@ altMaybe :: Maybe a -> Maybe a -> Maybe a altMaybe Nothing r = r altMaybe l _ = l +fromLazy :: Lazy.Maybe a -> Maybe a +fromLazy (Lazy.Just a) = Just a +fromLazy Lazy.Nothing = Nothing + +toLazy :: Maybe a -> Lazy.Maybe a +toLazy (Just a) = Lazy.Just a +toLazy Nothing = Lazy.Nothing + +expectJust :: HasCallStack => String -> Maybe a -> a +{-# INLINE expectJust #-} +expectJust _ (Just x) = x +expectJust err Nothing = error ("expectJust " ++ err) + instance Semigroup a => Semigroup (Maybe a) where Nothing <> b = b a <> Nothing = a ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -74,6 +74,7 @@ import GHC.Linker.Types import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Maybe +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Data.StringBuffer import GHC.Data.FastString import qualified GHC.Data.EnumSet as EnumSet @@ -772,7 +773,7 @@ summariseRequirement pn mod_name = do let PackageName pn_fs = pn let location = mkHomeModLocation2 fopts mod_name - (unpackFS pn_fs moduleNameSlashes mod_name) "hsig" + (unsafeEncodeUtf $ unpackFS pn_fs moduleNameSlashes mod_name) (unsafeEncodeUtf "hsig") env <- getBkpEnv src_hash <- liftIO $ getFileHash (bkp_filename env) @@ -855,12 +856,12 @@ hsModuleToModSummary home_keys pn hsc_src modname -- these filenames to figure out where the hi files go. -- A travesty! let location0 = mkHomeModLocation2 fopts modname - (unpackFS unit_fs + (unsafeEncodeUtf $ unpackFS unit_fs moduleNameSlashes modname) (case hsc_src of - HsigFile -> "hsig" - HsBootFile -> "hs-boot" - HsSrcFile -> "hs") + HsigFile -> unsafeEncodeUtf "hsig" + HsBootFile -> unsafeEncodeUtf "hs-boot" + HsSrcFile -> unsafeEncodeUtf "hs") -- DANGEROUS: bootifying can POISON the module finder cache let location = case hsc_src of HsBootFile -> addBootSuffixLocnOut location0 ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Driver.Ppr import GHC.Driver.Backend +import GHC.Data.OsPath import qualified GHC.Data.ShortText as ST import GHC.Data.Stream ( Stream ) import qualified GHC.Data.Stream as Stream @@ -259,7 +260,7 @@ outputForeignStubs Maybe FilePath) -- C file created outputForeignStubs logger tmpfs dflags unit_state mod location stubs = do - let stub_h = mkStubPaths (initFinderOpts dflags) (moduleName mod) location + let stub_h = unsafeDecodeUtf $ mkStubPaths (initFinderOpts dflags) (moduleName mod) location stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" case stubs of ===================================== compiler/GHC/Driver/Config/Finder.hs ===================================== @@ -5,30 +5,31 @@ module GHC.Driver.Config.Finder ( import GHC.Prelude +import qualified GHC.Data.Strict as Strict import GHC.Driver.DynFlags import GHC.Unit.Finder.Types import GHC.Data.FastString - +import GHC.Data.OsPath -- | Create a new 'FinderOpts' from DynFlags. initFinderOpts :: DynFlags -> FinderOpts initFinderOpts flags = FinderOpts - { finder_importPaths = importPaths flags + { finder_importPaths = fmap unsafeEncodeUtf $ importPaths flags , finder_lookupHomeInterfaces = isOneShot (ghcMode flags) , finder_bypassHiFileCheck = MkDepend == (ghcMode flags) , finder_ways = ways flags , finder_enableSuggestions = gopt Opt_HelpfulErrors flags - , finder_workingDirectory = workingDirectory flags + , finder_workingDirectory = fmap unsafeEncodeUtf $ Strict.fromLazy $ workingDirectory flags , finder_thisPackageName = mkFastString <$> thisPackageName flags , finder_hiddenModules = hiddenModules flags , finder_reexportedModules = reexportedModules flags - , finder_hieDir = hieDir flags - , finder_hieSuf = hieSuf flags - , finder_hiDir = hiDir flags - , finder_hiSuf = hiSuf_ flags - , finder_dynHiSuf = dynHiSuf_ flags - , finder_objectDir = objectDir flags - , finder_objectSuf = objectSuf_ flags - , finder_dynObjectSuf = dynObjectSuf_ flags - , finder_stubDir = stubDir flags + , finder_hieDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hieDir flags + , finder_hieSuf = unsafeEncodeUtf $ hieSuf flags + , finder_hiDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hiDir flags + , finder_hiSuf = unsafeEncodeUtf $ hiSuf_ flags + , finder_dynHiSuf = unsafeEncodeUtf $ dynHiSuf_ flags + , finder_objectDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ objectDir flags + , finder_objectSuf = unsafeEncodeUtf $ objectSuf_ flags + , finder_dynObjectSuf = unsafeEncodeUtf $ dynObjectSuf_ flags + , finder_stubDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ stubDir flags } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -264,6 +264,8 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString import GHC.Data.Bag +import GHC.Data.OsPath (unsafeEncodeUtf) +import qualified GHC.Data.Strict as Strict import GHC.Data.StringBuffer import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) @@ -2106,12 +2108,12 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs rawCmms return stub_c_exists where - no_loc = ModLocation{ ml_hs_file = Just original_filename, - ml_hi_file = panic "hscCompileCmmFile: no hi file", - ml_obj_file = panic "hscCompileCmmFile: no obj file", - ml_dyn_obj_file = panic "hscCompileCmmFile: no dyn obj file", - ml_dyn_hi_file = panic "hscCompileCmmFile: no dyn obj file", - ml_hie_file = panic "hscCompileCmmFile: no hie file"} + no_loc = ModLocation{ ml_hs_file_ = Strict.Just $ unsafeEncodeUtf original_filename, + ml_hi_file_ = panic "hscCompileCmmFile: no hi file", + ml_obj_file_ = panic "hscCompileCmmFile: no obj file", + ml_dyn_obj_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_dyn_hi_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_hie_file_ = panic "hscCompileCmmFile: no hie file"} -------------------- Stuff for new code gen --------------------- @@ -2346,12 +2348,12 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do {- Desugar it -} -- We use a basically null location for iNTERACTIVE - let iNTERACTIVELoc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hsDeclsWithLocation:ml_hi_file", - ml_obj_file = panic "hsDeclsWithLocation:ml_obj_file", - ml_dyn_obj_file = panic "hsDeclsWithLocation:ml_dyn_obj_file", - ml_dyn_hi_file = panic "hsDeclsWithLocation:ml_dyn_hi_file", - ml_hie_file = panic "hsDeclsWithLocation:ml_hie_file" } + let iNTERACTIVELoc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hsDeclsWithLocation:ml_hi_file", + ml_obj_file_ = panic "hsDeclsWithLocation:ml_obj_file", + ml_dyn_obj_file_ = panic "hsDeclsWithLocation:ml_dyn_obj_file", + ml_dyn_hi_file_ = panic "hsDeclsWithLocation:ml_dyn_hi_file", + ml_hie_file_ = panic "hsDeclsWithLocation:ml_hie_file" } ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv {- Simplify -} @@ -2630,12 +2632,12 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- Lint if necessary -} lintInteractiveExpr (text "hscCompileCoreExpr") hsc_env prepd_expr - let this_loc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file", - ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file", - ml_dyn_obj_file = panic "hscCompileCoreExpr': ml_obj_file", - ml_dyn_hi_file = panic "hscCompileCoreExpr': ml_dyn_hi_file", - ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } + let this_loc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hscCompileCoreExpr':ml_hi_file", + ml_obj_file_ = panic "hscCompileCoreExpr':ml_obj_file", + ml_dyn_obj_file_ = panic "hscCompileCoreExpr': ml_obj_file", + ml_dyn_hi_file_ = panic "hscCompileCoreExpr': ml_dyn_hi_file", + ml_hie_file_ = panic "hscCompileCoreExpr':ml_hie_file" } -- Ensure module uniqueness by giving it a name like "GhciNNNN". -- This uniqueness is needed by the JS linker. Without it we break the 1-1 ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -72,10 +72,12 @@ import GHC.Iface.Load ( cannotFindModule ) import GHC.IfaceToCore ( typecheckIface ) import GHC.Iface.Recomp ( RecompileRequired(..), CompileReason(..) ) +import qualified GHC.Data.Strict as Strict import GHC.Data.Bag ( listToBag ) import GHC.Data.Graph.Directed import GHC.Data.FastString import GHC.Data.Maybe ( expectJust ) +import GHC.Data.OsPath ( unsafeEncodeUtf, unsafeDecodeUtf ) import GHC.Data.StringBuffer import qualified GHC.LanguageExtensions as LangExt @@ -336,12 +338,15 @@ warnMissingHomeModules dflags targets mod_graph = -> moduleName (ms_mod mod) == name && tuid == ms_unitid mod TargetFile target_file _ - | Just mod_file <- ml_hs_file (ms_location mod) + | Strict.Just mod_file <- ml_hs_file_ (ms_location mod) -> - augmentByWorkingDirectory dflags target_file == mod_file || + let + target_os_file = unsafeEncodeUtf target_file + in + augmentByWorkingDirectory dflags target_file == unsafeDecodeUtf mod_file || -- Don't warn on B.hs-boot if B.hs is specified (#16551) - addBootSuffix target_file == mod_file || + addBootSuffix target_os_file == mod_file || -- We can get a file target even if a module name was -- originally specified in a command line because it can @@ -1830,7 +1835,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf let dyn_tn = tn -<.> dynsuf addFilesToClean tmpfs dynLife [dyn_tn] - return (tn, dyn_tn) + return (unsafeEncodeUtf tn, unsafeEncodeUtf dyn_tn) -- We don't want to create .o or .hi files unless we have been asked -- to by the user. But we need them, so we patch their locations in -- the ModSummary with temporary files. @@ -1839,8 +1844,8 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- If ``-fwrite-interface` is specified, then the .o and .hi files -- are written into `-odir` and `-hidir` respectively. #16670 if gopt Opt_WriteInterface dflags - then return ((ml_hi_file ms_location, ml_dyn_hi_file ms_location) - , (ml_obj_file ms_location, ml_dyn_obj_file ms_location)) + then return ((ml_hi_file_ ms_location, ml_dyn_hi_file_ ms_location) + , (ml_obj_file_ ms_location, ml_dyn_obj_file_ ms_location)) else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) let new_dflags = case enable_spec of @@ -1849,10 +1854,10 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} let ms' = ms { ms_location = - ms_location { ml_hi_file = hi_file - , ml_obj_file = o_file - , ml_dyn_hi_file = dyn_hi_file - , ml_dyn_obj_file = dyn_o_file } + ms_location { ml_hi_file_ = hi_file + , ml_obj_file_ = o_file + , ml_dyn_hi_file_ = dyn_hi_file + , ml_dyn_obj_file_ = dyn_o_file } , ms_hspp_opts = updOptLevel 0 $ new_dflags } -- Recursive call to catch the other cases @@ -2037,7 +2042,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf let fopts = initFinderOpts (hsc_dflags hsc_env) -- Make a ModLocation for this file - let location = mkHomeModLocation fopts pi_mod_name src_fn + let location = mkHomeModLocation fopts pi_mod_name (unsafeEncodeUtf src_fn) -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Driver.Env import GHC.Driver.Errors.Types import qualified GHC.SysTools as SysTools import GHC.Data.Graph.Directed ( SCC(..) ) +import GHC.Data.OsPath (unsafeDecodeUtf) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SourceError @@ -297,7 +298,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do Found loc _ -- Home package: just depend on the .hi or hi-boot file | isJust (ml_hs_file loc) || include_pkg_deps - -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc))) + -> return (Just (unsafeDecodeUtf $ addBootSuffix_maybe is_boot (ml_hi_file_ loc))) -- Not in this package: we don't need a dependency | otherwise ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -58,6 +58,7 @@ import GHC.Iface.Make import GHC.Driver.Config.Parser import GHC.Parser.Header import GHC.Data.StringBuffer +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Types.SourceError import GHC.Unit.Finder import Data.IORef @@ -759,7 +760,7 @@ mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO Mod mkOneShotModLocation pipe_env dflags src_flavour mod_name = do let PipeEnv{ src_basename=basename, src_suffix=suff } = pipe_env - let location1 = mkHomeModLocation2 fopts mod_name basename suff + let location1 = mkHomeModLocation2 fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff) -- Boot-ify it if necessary let location2 @@ -771,11 +772,11 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do -- This can't be done in mkHomeModuleLocation because -- it only applies to the module being compiles let ohi = outputHi dflags - location3 | Just fn <- ohi = location2{ ml_hi_file = fn } + location3 | Just fn <- ohi = location2{ ml_hi_file_ = unsafeEncodeUtf fn } | otherwise = location2 let dynohi = dynOutputHi dflags - location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file = fn } + location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file_ = unsafeEncodeUtf fn } | otherwise = location3 -- Take -o into account if present @@ -789,10 +790,10 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do location5 | Just ofile <- expl_o_file , let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file , isNoLink (ghcLink dflags) - = location4 { ml_obj_file = ofile - , ml_dyn_obj_file = dyn_ofile } + = location4 { ml_obj_file_ = unsafeEncodeUtf ofile + , ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | Just dyn_ofile <- expl_dyn_o_file - = location4 { ml_dyn_obj_file = dyn_ofile } + = location4 { ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | otherwise = location4 return location5 where ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Utils.Panic.Plain import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Data.Maybe +import GHC.Data.OsPath import GHC.Prelude import GHC.Unit import GHC.Unit.Env @@ -55,13 +56,13 @@ cantFindInstalledErr unit_state mhome_unit profile mod_name find_result InstalledNotFound files mb_pkg | Just pkg <- mb_pkg , notHomeUnitId mhome_unit pkg - -> not_found_in_package pkg files + -> not_found_in_package pkg $ fmap unsafeDecodeUtf files | null files -> NotAModule | otherwise - -> CouldntFindInFiles files + -> CouldntFindInFiles $ fmap unsafeDecodeUtf files _ -> panic "cantFindInstalledErr" ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -42,6 +42,9 @@ import GHC.Platform.Ways import GHC.Builtin.Names ( gHC_PRIM ) +import qualified GHC.Data.Strict as Strict +import GHC.Data.OsPath + import GHC.Unit.Env import GHC.Unit.Types import GHC.Unit.Module @@ -49,7 +52,6 @@ import GHC.Unit.Home import GHC.Unit.State import GHC.Unit.Finder.Types -import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.ShortText as ST import GHC.Utils.Misc @@ -61,8 +63,7 @@ import GHC.Types.PkgQual import GHC.Fingerprint import Data.IORef -import System.Directory -import System.FilePath +import System.Directory.OsPath import Control.Monad import Data.Time import qualified Data.Map as M @@ -70,9 +71,10 @@ import GHC.Driver.Env ( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env) ) import GHC.Driver.Config.Finder import qualified Data.Set as Set +import qualified System.OsPath as OsPath -type FileExt = String -- Filename extension -type BaseName = String -- Basename of file +type FileExt = OsPath -- Filename extension +type BaseName = OsPath -- Basename of file -- ----------------------------------------------------------------------------- -- The Finder @@ -286,7 +288,7 @@ findLookupResult fc fopts r = case r of -- implicit locations from the instances InstalledFound loc _ -> return (Found loc m) InstalledNoPackage _ -> return (NoPackage (moduleUnit m)) - InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m) + InstalledNotFound fp _ -> return (NotFound{ fr_paths = fmap unsafeDecodeUtf fp, fr_pkg = Just (moduleUnit m) , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_unusables = [] @@ -357,7 +359,7 @@ findHomeModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -382,7 +384,7 @@ findHomePackageModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkModule uid mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -413,22 +415,22 @@ findInstalledHomeModule fc fopts home_unit mod_name = do let maybe_working_dir = finder_workingDirectory fopts home_path = case maybe_working_dir of - Nothing -> finder_importPaths fopts - Just fp -> augmentImports fp (finder_importPaths fopts) + Strict.Nothing -> finder_importPaths fopts + Strict.Just fp -> augmentImports fp (finder_importPaths fopts) hi_dir_path = case finder_hiDir fopts of - Just hiDir -> case maybe_working_dir of - Nothing -> [hiDir] - Just fp -> [fp hiDir] - Nothing -> home_path + Strict.Just hiDir -> case maybe_working_dir of + Strict.Nothing -> [hiDir] + Strict.Just fp -> [fp hiDir] + Strict.Nothing -> home_path hisuf = finder_hiSuf fopts mod = mkModule home_unit mod_name source_exts = - [ ("hs", mkHomeModLocationSearched fopts mod_name "hs") - , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs") - , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig") - , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig") + [ (unsafeEncodeUtf "hs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hs") + , (unsafeEncodeUtf "lhs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhs") + , (unsafeEncodeUtf "hsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hsig") + , (unsafeEncodeUtf "lhsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhsig") ] -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that @@ -453,9 +455,9 @@ findInstalledHomeModule fc fopts home_unit mod_name = do else searchPathExts search_dirs mod exts -- | Prepend the working directory to the search path. -augmentImports :: FilePath -> [FilePath] -> [FilePath] +augmentImports :: OsPath -> [OsPath] -> [OsPath] augmentImports _work_dir [] = [] -augmentImports work_dir (fp:fps) | isAbsolute fp = fp : augmentImports work_dir fps +augmentImports work_dir (fp:fps) | OsPath.isAbsolute fp = fp : augmentImports work_dir fps | otherwise = (work_dir fp) : augmentImports work_dir fps -- | Search for a module in external packages only. @@ -488,14 +490,14 @@ findPackageModule_ fc fopts mod pkg_conf = do tag = waysBuildTag (finder_ways fopts) -- hi-suffix for packages depends on the build tag. - package_hisuf | null tag = "hi" - | otherwise = tag ++ "_hi" + package_hisuf | null tag = unsafeEncodeUtf $ "hi" + | otherwise = unsafeEncodeUtf $ tag ++ "_hi" - package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" + package_dynhisuf = unsafeEncodeUtf $ waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf package_dynhisuf - import_dirs = map ST.unpack $ unitImportDirs pkg_conf + import_dirs = map (unsafeEncodeUtf . ST.unpack) $ unitImportDirs pkg_conf -- we never look for a .hi-boot file in an external package; -- .hi-boot files only make sense for the home package. in @@ -503,7 +505,7 @@ findPackageModule_ fc fopts mod pkg_conf = do [one] | finder_bypassHiFileCheck fopts -> -- there's only one place that this .hi file can be, so -- don't bother looking for it. - let basename = moduleNameSlashes (moduleName mod) + let basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) loc = mk_hi_loc one basename in return $ InstalledFound loc mod _otherwise -> @@ -512,24 +514,24 @@ findPackageModule_ fc fopts mod pkg_conf = do -- ----------------------------------------------------------------------------- -- General path searching -searchPathExts :: [FilePath] -- paths to search +searchPathExts :: [OsPath] -- paths to search -> InstalledModule -- module name -> [ ( FileExt, -- suffix - FilePath -> BaseName -> ModLocation -- action + OsPath -> BaseName -> ModLocation -- action ) ] -> IO InstalledFindResult searchPathExts paths mod exts = search to_search where - basename = moduleNameSlashes (moduleName mod) + basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) - to_search :: [(FilePath, ModLocation)] + to_search :: [(OsPath, ModLocation)] to_search = [ (file, fn path basename) | path <- paths, (ext,fn) <- exts, - let base | path == "." = basename + let base | path == unsafeEncodeUtf "." = basename | otherwise = path basename file = base <.> ext ] @@ -543,7 +545,7 @@ searchPathExts paths mod exts = search to_search else search rest mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt - -> FilePath -> BaseName -> ModLocation + -> OsPath -> BaseName -> ModLocation mkHomeModLocationSearched fopts mod suff path basename = mkHomeModLocation2 fopts mod (path basename) suff @@ -581,18 +583,18 @@ mkHomeModLocationSearched fopts mod suff path basename = -- ext -- The filename extension of the source file (usually "hs" or "lhs"). -mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation +mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> ModLocation mkHomeModLocation dflags mod src_filename = - let (basename,extension) = splitExtension src_filename + let (basename,extension) = OsPath.splitExtension src_filename in mkHomeModLocation2 dflags mod basename extension mkHomeModLocation2 :: FinderOpts -> ModuleName - -> FilePath -- Of source module, without suffix - -> String -- Suffix + -> OsPath -- Of source module, without suffix + -> OsPath -- Suffix -> ModLocation mkHomeModLocation2 fopts mod src_basename ext = - let mod_basename = moduleNameSlashes mod + let mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod obj_fn = mkObjPath fopts src_basename mod_basename dyn_obj_fn = mkDynObjPath fopts src_basename mod_basename @@ -600,72 +602,72 @@ mkHomeModLocation2 fopts mod src_basename ext = dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename hie_fn = mkHiePath fopts src_basename mod_basename - in (ModLocation{ ml_hs_file = Just (src_basename <.> ext), - ml_hi_file = hi_fn, - ml_dyn_hi_file = dyn_hi_fn, - ml_obj_file = obj_fn, - ml_dyn_obj_file = dyn_obj_fn, - ml_hie_file = hie_fn }) + in (ModLocation{ ml_hs_file_ = Strict.Just (src_basename <.> ext), + ml_hi_file_ = hi_fn, + ml_dyn_hi_file_ = dyn_hi_fn, + ml_obj_file_ = obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, + ml_hie_file_ = hie_fn }) mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName - -> FilePath + -> OsPath -> BaseName -> ModLocation mkHomeModHiOnlyLocation fopts mod path basename = - let loc = mkHomeModLocation2 fopts mod (path basename) "" - in loc { ml_hs_file = Nothing } + let loc = mkHomeModLocation2 fopts mod (path basename) mempty + in loc { ml_hs_file_ = Strict.Nothing } -- This function is used to make a ModLocation for a package module. Hence why -- we explicitly pass in the interface file suffixes. -mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String +mkHiOnlyModLocation :: FinderOpts -> OsPath -> OsPath -> OsPath -> OsPath -> ModLocation mkHiOnlyModLocation fopts hisuf dynhisuf path basename = let full_basename = path basename obj_fn = mkObjPath fopts full_basename basename dyn_obj_fn = mkDynObjPath fopts full_basename basename hie_fn = mkHiePath fopts full_basename basename - in ModLocation{ ml_hs_file = Nothing, - ml_hi_file = full_basename <.> hisuf, + in ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = full_basename <.> hisuf, -- Remove the .hi-boot suffix from -- hi_file, if it had one. We always -- want the name of the real .hi file -- in the ml_hi_file field. - ml_dyn_obj_file = dyn_obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, -- MP: TODO - ml_dyn_hi_file = full_basename <.> dynhisuf, - ml_obj_file = obj_fn, - ml_hie_file = hie_fn + ml_dyn_hi_file_ = full_basename <.> dynhisuf, + ml_obj_file_ = obj_fn, + ml_hie_file_ = hie_fn } -- | Constructs the filename of a .o file for a given source file. -- Does /not/ check whether the .o file exists mkObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath -mkObjPath fopts basename mod_basename = obj_basename <.> osuf + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath +mkObjPath fopts basename mod_basename = obj_basename OsPath.<.> osuf where odir = finder_objectDir fopts osuf = finder_objectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir OsPath. mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_o file for a given source file. -- Does /not/ check whether the .dyn_o file exists mkDynObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf where odir = finder_objectDir fopts dynosuf = finder_dynObjectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir mod_basename | otherwise = basename @@ -673,45 +675,45 @@ mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf -- Does /not/ check whether the .hi file exists mkHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiPath fopts basename mod_basename = hi_basename <.> hisuf where hidir = finder_hiDir fopts hisuf = finder_hiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_hi file for a given source file. -- Does /not/ check whether the .dyn_hi file exists mkDynHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf where hidir = finder_hiDir fopts dynhisuf = finder_dynHiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .hie file for a given source file. -- Does /not/ check whether the .hie file exists mkHiePath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf where hiedir = finder_hieDir fopts hiesuf = finder_hieSuf fopts - hie_basename | Just dir <- hiedir = dir mod_basename + hie_basename | Strict.Just dir <- hiedir = dir mod_basename | otherwise = basename @@ -726,23 +728,23 @@ mkStubPaths :: FinderOpts -> ModuleName -> ModLocation - -> FilePath + -> OsPath mkStubPaths fopts mod location = let stubdir = finder_stubDir fopts - mod_basename = moduleNameSlashes mod - src_basename = dropExtension $ expectJust "mkStubPaths" - (ml_hs_file location) + mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod + src_basename = OsPath.dropExtension $ Strict.expectJust "mkStubPaths" + (ml_hs_file_ location) stub_basename0 - | Just dir <- stubdir = dir mod_basename + | Strict.Just dir <- stubdir = dir mod_basename | otherwise = src_basename - stub_basename = stub_basename0 ++ "_stub" + stub_basename = stub_basename0 `mappend` unsafeEncodeUtf "_stub" in - stub_basename <.> "h" + stub_basename <.> unsafeEncodeUtf "h" -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -9,6 +9,7 @@ where import GHC.Prelude import GHC.Unit +import qualified GHC.Data.Strict as Strict import qualified Data.Map as M import GHC.Fingerprint import GHC.Platform.Ways @@ -16,6 +17,7 @@ import GHC.Platform.Ways import Data.IORef import GHC.Data.FastString import qualified Data.Set as Set +import System.OsPath (OsPath) -- | The 'FinderCache' maps modules to the result of -- searching for that module. It records the results of searching for @@ -31,7 +33,7 @@ data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState) data InstalledFindResult = InstalledFound ModLocation InstalledModule | InstalledNoPackage UnitId - | InstalledNotFound [FilePath] (Maybe UnitId) + | InstalledNotFound [OsPath] (Maybe UnitId) -- | The result of searching for an imported module. -- @@ -70,7 +72,7 @@ data FindResult -- -- Should be taken from 'DynFlags' via 'initFinderOpts'. data FinderOpts = FinderOpts - { finder_importPaths :: [FilePath] + { finder_importPaths :: [OsPath] -- ^ Where are we allowed to look for Modules and Source files , finder_lookupHomeInterfaces :: Bool -- ^ When looking up a home module: @@ -88,17 +90,17 @@ data FinderOpts = FinderOpts , finder_enableSuggestions :: Bool -- ^ If we encounter unknown modules, should we suggest modules -- that have a similar name. - , finder_workingDirectory :: Maybe FilePath + , finder_workingDirectory :: Strict.Maybe OsPath , finder_thisPackageName :: Maybe FastString , finder_hiddenModules :: Set.Set ModuleName , finder_reexportedModules :: Set.Set ModuleName - , finder_hieDir :: Maybe FilePath - , finder_hieSuf :: String - , finder_hiDir :: Maybe FilePath - , finder_hiSuf :: String - , finder_dynHiSuf :: String - , finder_objectDir :: Maybe FilePath - , finder_objectSuf :: String - , finder_dynObjectSuf :: String - , finder_stubDir :: Maybe FilePath + , finder_hieDir :: Strict.Maybe OsPath + , finder_hieSuf :: OsPath + , finder_hiDir :: Strict.Maybe OsPath + , finder_hiSuf :: OsPath + , finder_dynHiSuf :: OsPath + , finder_objectDir :: Strict.Maybe OsPath + , finder_objectSuf :: OsPath + , finder_dynObjectSuf :: OsPath + , finder_stubDir :: Strict.Maybe OsPath } deriving Show ===================================== compiler/GHC/Unit/Module/Location.hs ===================================== @@ -7,10 +7,19 @@ module GHC.Unit.Module.Location , addBootSuffixLocn , addBootSuffixLocnOut , removeBootSuffix + , ml_hs_file + , ml_hi_file + , ml_dyn_hi_file + , ml_obj_file + , ml_dyn_obj_file + , ml_hie_file ) where import GHC.Prelude + +import GHC.Data.OsPath +import qualified GHC.Data.Strict as Strict import GHC.Unit.Types import GHC.Utils.Outputable @@ -39,30 +48,30 @@ import GHC.Utils.Outputable data ModLocation = ModLocation { - ml_hs_file :: Maybe FilePath, + ml_hs_file_ :: Strict.Maybe OsPath, -- ^ The source file, if we have one. Package modules -- probably don't have source files. - ml_hi_file :: FilePath, + ml_hi_file_ :: OsPath, -- ^ Where the .hi file is, whether or not it exists -- yet. Always of form foo.hi, even if there is an -- hi-boot file (we add the -boot suffix later) - ml_dyn_hi_file :: FilePath, + ml_dyn_hi_file_ :: OsPath, -- ^ Where the .dyn_hi file is, whether or not it exists -- yet. - ml_obj_file :: FilePath, + ml_obj_file_ :: OsPath, -- ^ Where the .o file is, whether or not it exists yet. -- (might not exist either because the module hasn't -- been compiled yet, or because it is part of a -- unit with a .a file) - ml_dyn_obj_file :: FilePath, + ml_dyn_obj_file_ :: OsPath, -- ^ Where the .dy file is, whether or not it exists -- yet. - ml_hie_file :: FilePath + ml_hie_file_ :: OsPath -- ^ Where the .hie file is, whether or not it exists -- yet. } deriving Show @@ -71,8 +80,8 @@ instance Outputable ModLocation where ppr = text . show -- | Add the @-boot@ suffix to .hs, .hi and .o files -addBootSuffix :: FilePath -> FilePath -addBootSuffix path = path ++ "-boot" +addBootSuffix :: OsPath -> OsPath +addBootSuffix path = path `mappend` unsafeEncodeUtf "-boot" -- | Remove the @-boot@ suffix to .hs, .hi and .o files removeBootSuffix :: FilePath -> FilePath @@ -82,7 +91,7 @@ removeBootSuffix [] = error "removeBootSuffix: no -boot suffix" -- | Add the @-boot@ suffix if the @Bool@ argument is @True@ -addBootSuffix_maybe :: IsBootInterface -> FilePath -> FilePath +addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath addBootSuffix_maybe is_boot path = case is_boot of IsBoot -> addBootSuffix path NotBoot -> path @@ -95,22 +104,42 @@ addBootSuffixLocn_maybe is_boot locn = case is_boot of -- | Add the @-boot@ suffix to all file paths associated with the module addBootSuffixLocn :: ModLocation -> ModLocation addBootSuffixLocn locn - = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn) - , ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) } + = locn { ml_hs_file_ = fmap addBootSuffix (ml_hs_file_ locn) + , ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } -- | Add the @-boot@ suffix to all output file paths associated with the -- module, not including the input file itself addBootSuffixLocnOut :: ModLocation -> ModLocation addBootSuffixLocnOut locn - = locn { ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) + = locn { ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } +-- ---------------------------------------------------------------------------- +-- Helpers for backwards compatibility +-- ---------------------------------------------------------------------------- + +ml_hs_file :: ModLocation -> Maybe FilePath +ml_hs_file = fmap unsafeDecodeUtf . Strict.toLazy . ml_hs_file_ + +ml_hi_file :: ModLocation -> FilePath +ml_hi_file = unsafeDecodeUtf . ml_hi_file_ + +ml_dyn_hi_file :: ModLocation -> FilePath +ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ + +ml_obj_file :: ModLocation -> FilePath +ml_obj_file = unsafeDecodeUtf . ml_obj_file_ + +ml_dyn_obj_file :: ModLocation -> FilePath +ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ +ml_hie_file :: ModLocation -> FilePath +ml_hie_file = unsafeDecodeUtf . ml_hie_file_ ===================================== compiler/ghc.cabal.in ===================================== @@ -428,6 +428,7 @@ Library GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList + GHC.Data.OsPath GHC.Data.Pair GHC.Data.SmallArray GHC.Data.Stream ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe +Subproject commit 1ef6c187b31f85dfd7133b150b211ec9140cc84a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c1cd8009d9c8cf2666adb9af7449efafc7adcbb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c1cd8009d9c8cf2666adb9af7449efafc7adcbb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 09:35:24 2024 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Wed, 03 Apr 2024 05:35:24 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Implement Or Patterns (#22596) Message-ID: <660d22dce6909_2422d3ad57c8119855@gitlab.mail> Sebastian Graf pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 4c0c2287 by David Knothe at 2024-04-03T11:35:14+02:00 Implement Or Patterns (#22596) This commit introduces a new language extension, `-XOrPatterns`, as described in GHC Proposal 522. An or-pattern `pat1; ...; patk` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. See also the summary `Note [Implmentation of OrPatterns]`. Co-Authored-By: Sebastian Graf <sgraf1337 at gmail.com> - - - - - 30 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - + docs/users_guide/exts/or_patterns.rst - docs/users_guide/exts/patterns.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c0c228760e1e960756e36e1e632f115b14f2fb8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c0c228760e1e960756e36e1e632f115b14f2fb8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 10:02:37 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 03 Apr 2024 06:02:37 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 2 commits: fixup! rts: lookupSymbolInNativeObj in Windows Message-ID: <660d293db1d48_2422d31111470140883@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: c77a4119 by Rodrigo Mesquita at 2024-04-03T11:02:21+01:00 fixup! rts: lookupSymbolInNativeObj in Windows - - - - - 0bca53c2 by Rodrigo Mesquita at 2024-04-03T11:02:21+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 9 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -634,6 +634,7 @@ internal_dlsym(const char *symbol) { // we failed to find the symbol return NULL; } +# endif void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { @@ -643,16 +644,20 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; } -# endif const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,19 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { - IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1884,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,7 +1,10 @@ -#include "CheckUnload.h" -#include "ForeignExports.h" #include "LinkerInternals.h" #include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" #include "RtsUtils.h" #include "Profiling.h" @@ -208,4 +211,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1017,7 +1017,10 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f stgFree(dllName); IF_DEBUG(linker, debugBelch("loadArchive: read symbol %s from lib `%" PATH_FMT "'\n", symbol, dll)); - const char* result = addDLL(dll); + // We must call `addDLL_PEi386` directly rather than `addDLL` because `addDLL` + // is now a wrapper around `loadNativeObj` which acquires a lock which we + // already have here. + const char* result = addDLL_PEi386(dll, NULL); stgFree(image); @@ -1141,47 +1144,55 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent); + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name STG_UNUSED, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+1,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2befe7f0d625968b12c2e2637b3731cdeb2d1234...0bca53c232f1b65fb49d7b1c89bb553346ff4032 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2befe7f0d625968b12c2e2637b3731cdeb2d1234...0bca53c232f1b65fb49d7b1c89bb553346ff4032 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 10:22:16 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Wed, 03 Apr 2024 06:22:16 -0400 Subject: [Git][ghc/ghc][wip/fendor/os-string-modlocation] Migrate `Finder` component to `OsPath` Message-ID: <660d2dd8d1378_4ce5c2c23c45979a@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/os-string-modlocation at Glasgow Haskell Compiler / GHC Commits: 2622622f by Fendor at 2024-04-03T12:21:59+02:00 Migrate `Finder` component to `OsPath` For each module in a GHCi session, we keep alive one `ModLocation`. A `ModLocation` is fairly inefficiently packed, as `String`s are expensive in memory usage. While benchmarking the agda codebase, we concluded that we keep alive around 11MB of `FilePath`'s, solely retained by `ModLocation`. We provide a more densely packed encoding of `ModLocation`, by moving from `FilePath` to `OsPath`. Further, we migrate the full `Finder` component to `OsPath` to avoid unnecessary transformations. As the `Finder` component is well-encapsuled, this requires only a minimal amount of changes in other modules. Bump to haddock submodule for `ModLocation` changes. - - - - - 18 changed files: - compiler/GHC.hs - + compiler/GHC/Data/OsPath.hs - compiler/GHC/Data/Strict.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Location.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - utils/haddock Changes: ===================================== compiler/GHC.hs ===================================== @@ -76,6 +76,12 @@ module GHC ( ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries, mgLookupModule, ModSummary(..), ms_mod_name, ModLocation(..), + ml_hs_file, + ml_hi_file, + ml_dyn_hi_file, + ml_obj_file, + ml_dyn_obj_file, + ml_hie_file, getModSummary, getModuleGraph, isLoaded, ===================================== compiler/GHC/Data/OsPath.hs ===================================== @@ -0,0 +1,19 @@ +module GHC.Data.OsPath + ( + -- * OsPath initialisation and transformation + OsPath + , unsafeDecodeUtf + , unsafeEncodeUtf + -- * Common utility functions + , () + , (<.>) + ) + where + +import GHC.Prelude + +import System.OsPath +import Data.Either + +unsafeDecodeUtf :: OsPath -> FilePath +unsafeDecodeUtf = fromRight (error "unsafeEncodeUtf: Internal error") . decodeUtf ===================================== compiler/GHC/Data/Strict.hs ===================================== @@ -9,8 +9,11 @@ module GHC.Data.Strict ( Maybe(Nothing, Just), fromMaybe, + GHC.Data.Strict.maybe, Pair(And), - + expectJust, + fromLazy, + toLazy, -- Not used at the moment: -- -- Either(Left, Right), @@ -18,9 +21,12 @@ module GHC.Data.Strict ( ) where import GHC.Prelude hiding (Maybe(..), Either(..)) +import GHC.Stack.Types + import Control.Applicative import Data.Semigroup import Data.Data +import qualified Data.Maybe as Lazy data Maybe a = Nothing | Just !a deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data) @@ -29,6 +35,10 @@ fromMaybe :: a -> Maybe a -> a fromMaybe d Nothing = d fromMaybe _ (Just x) = x +maybe :: b -> (a -> b) -> Maybe a -> b +maybe d _ Nothing = d +maybe _ f (Just x) = f x + apMaybe :: Maybe (a -> b) -> Maybe a -> Maybe b apMaybe (Just f) (Just x) = Just (f x) apMaybe _ _ = Nothing @@ -37,6 +47,19 @@ altMaybe :: Maybe a -> Maybe a -> Maybe a altMaybe Nothing r = r altMaybe l _ = l +fromLazy :: Lazy.Maybe a -> Maybe a +fromLazy (Lazy.Just a) = Just a +fromLazy Lazy.Nothing = Nothing + +toLazy :: Maybe a -> Lazy.Maybe a +toLazy (Just a) = Lazy.Just a +toLazy Nothing = Lazy.Nothing + +expectJust :: HasCallStack => String -> Maybe a -> a +{-# INLINE expectJust #-} +expectJust _ (Just x) = x +expectJust err Nothing = error ("expectJust " ++ err) + instance Semigroup a => Semigroup (Maybe a) where Nothing <> b = b a <> Nothing = a ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -74,6 +74,7 @@ import GHC.Linker.Types import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Maybe +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Data.StringBuffer import GHC.Data.FastString import qualified GHC.Data.EnumSet as EnumSet @@ -772,7 +773,7 @@ summariseRequirement pn mod_name = do let PackageName pn_fs = pn let location = mkHomeModLocation2 fopts mod_name - (unpackFS pn_fs moduleNameSlashes mod_name) "hsig" + (unsafeEncodeUtf $ unpackFS pn_fs moduleNameSlashes mod_name) (unsafeEncodeUtf "hsig") env <- getBkpEnv src_hash <- liftIO $ getFileHash (bkp_filename env) @@ -855,12 +856,12 @@ hsModuleToModSummary home_keys pn hsc_src modname -- these filenames to figure out where the hi files go. -- A travesty! let location0 = mkHomeModLocation2 fopts modname - (unpackFS unit_fs + (unsafeEncodeUtf $ unpackFS unit_fs moduleNameSlashes modname) (case hsc_src of - HsigFile -> "hsig" - HsBootFile -> "hs-boot" - HsSrcFile -> "hs") + HsigFile -> unsafeEncodeUtf "hsig" + HsBootFile -> unsafeEncodeUtf "hs-boot" + HsSrcFile -> unsafeEncodeUtf "hs") -- DANGEROUS: bootifying can POISON the module finder cache let location = case hsc_src of HsBootFile -> addBootSuffixLocnOut location0 ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Driver.Ppr import GHC.Driver.Backend +import GHC.Data.OsPath import qualified GHC.Data.ShortText as ST import GHC.Data.Stream ( Stream ) import qualified GHC.Data.Stream as Stream @@ -259,7 +260,7 @@ outputForeignStubs Maybe FilePath) -- C file created outputForeignStubs logger tmpfs dflags unit_state mod location stubs = do - let stub_h = mkStubPaths (initFinderOpts dflags) (moduleName mod) location + let stub_h = unsafeDecodeUtf $ mkStubPaths (initFinderOpts dflags) (moduleName mod) location stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" case stubs of ===================================== compiler/GHC/Driver/Config/Finder.hs ===================================== @@ -5,30 +5,31 @@ module GHC.Driver.Config.Finder ( import GHC.Prelude +import qualified GHC.Data.Strict as Strict import GHC.Driver.DynFlags import GHC.Unit.Finder.Types import GHC.Data.FastString - +import GHC.Data.OsPath -- | Create a new 'FinderOpts' from DynFlags. initFinderOpts :: DynFlags -> FinderOpts initFinderOpts flags = FinderOpts - { finder_importPaths = importPaths flags + { finder_importPaths = fmap unsafeEncodeUtf $ importPaths flags , finder_lookupHomeInterfaces = isOneShot (ghcMode flags) , finder_bypassHiFileCheck = MkDepend == (ghcMode flags) , finder_ways = ways flags , finder_enableSuggestions = gopt Opt_HelpfulErrors flags - , finder_workingDirectory = workingDirectory flags + , finder_workingDirectory = fmap unsafeEncodeUtf $ Strict.fromLazy $ workingDirectory flags , finder_thisPackageName = mkFastString <$> thisPackageName flags , finder_hiddenModules = hiddenModules flags , finder_reexportedModules = reexportedModules flags - , finder_hieDir = hieDir flags - , finder_hieSuf = hieSuf flags - , finder_hiDir = hiDir flags - , finder_hiSuf = hiSuf_ flags - , finder_dynHiSuf = dynHiSuf_ flags - , finder_objectDir = objectDir flags - , finder_objectSuf = objectSuf_ flags - , finder_dynObjectSuf = dynObjectSuf_ flags - , finder_stubDir = stubDir flags + , finder_hieDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hieDir flags + , finder_hieSuf = unsafeEncodeUtf $ hieSuf flags + , finder_hiDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hiDir flags + , finder_hiSuf = unsafeEncodeUtf $ hiSuf_ flags + , finder_dynHiSuf = unsafeEncodeUtf $ dynHiSuf_ flags + , finder_objectDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ objectDir flags + , finder_objectSuf = unsafeEncodeUtf $ objectSuf_ flags + , finder_dynObjectSuf = unsafeEncodeUtf $ dynObjectSuf_ flags + , finder_stubDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ stubDir flags } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -264,6 +264,8 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString import GHC.Data.Bag +import GHC.Data.OsPath (unsafeEncodeUtf) +import qualified GHC.Data.Strict as Strict import GHC.Data.StringBuffer import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) @@ -2106,12 +2108,12 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs rawCmms return stub_c_exists where - no_loc = ModLocation{ ml_hs_file = Just original_filename, - ml_hi_file = panic "hscCompileCmmFile: no hi file", - ml_obj_file = panic "hscCompileCmmFile: no obj file", - ml_dyn_obj_file = panic "hscCompileCmmFile: no dyn obj file", - ml_dyn_hi_file = panic "hscCompileCmmFile: no dyn obj file", - ml_hie_file = panic "hscCompileCmmFile: no hie file"} + no_loc = ModLocation{ ml_hs_file_ = Strict.Just $ unsafeEncodeUtf original_filename, + ml_hi_file_ = panic "hscCompileCmmFile: no hi file", + ml_obj_file_ = panic "hscCompileCmmFile: no obj file", + ml_dyn_obj_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_dyn_hi_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_hie_file_ = panic "hscCompileCmmFile: no hie file"} -------------------- Stuff for new code gen --------------------- @@ -2346,12 +2348,12 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do {- Desugar it -} -- We use a basically null location for iNTERACTIVE - let iNTERACTIVELoc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hsDeclsWithLocation:ml_hi_file", - ml_obj_file = panic "hsDeclsWithLocation:ml_obj_file", - ml_dyn_obj_file = panic "hsDeclsWithLocation:ml_dyn_obj_file", - ml_dyn_hi_file = panic "hsDeclsWithLocation:ml_dyn_hi_file", - ml_hie_file = panic "hsDeclsWithLocation:ml_hie_file" } + let iNTERACTIVELoc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hsDeclsWithLocation:ml_hi_file", + ml_obj_file_ = panic "hsDeclsWithLocation:ml_obj_file", + ml_dyn_obj_file_ = panic "hsDeclsWithLocation:ml_dyn_obj_file", + ml_dyn_hi_file_ = panic "hsDeclsWithLocation:ml_dyn_hi_file", + ml_hie_file_ = panic "hsDeclsWithLocation:ml_hie_file" } ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv {- Simplify -} @@ -2630,12 +2632,12 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- Lint if necessary -} lintInteractiveExpr (text "hscCompileCoreExpr") hsc_env prepd_expr - let this_loc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file", - ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file", - ml_dyn_obj_file = panic "hscCompileCoreExpr': ml_obj_file", - ml_dyn_hi_file = panic "hscCompileCoreExpr': ml_dyn_hi_file", - ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } + let this_loc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hscCompileCoreExpr':ml_hi_file", + ml_obj_file_ = panic "hscCompileCoreExpr':ml_obj_file", + ml_dyn_obj_file_ = panic "hscCompileCoreExpr': ml_obj_file", + ml_dyn_hi_file_ = panic "hscCompileCoreExpr': ml_dyn_hi_file", + ml_hie_file_ = panic "hscCompileCoreExpr':ml_hie_file" } -- Ensure module uniqueness by giving it a name like "GhciNNNN". -- This uniqueness is needed by the JS linker. Without it we break the 1-1 ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -72,10 +72,12 @@ import GHC.Iface.Load ( cannotFindModule ) import GHC.IfaceToCore ( typecheckIface ) import GHC.Iface.Recomp ( RecompileRequired(..), CompileReason(..) ) +import qualified GHC.Data.Strict as Strict import GHC.Data.Bag ( listToBag ) import GHC.Data.Graph.Directed import GHC.Data.FastString import GHC.Data.Maybe ( expectJust ) +import GHC.Data.OsPath ( unsafeEncodeUtf, unsafeDecodeUtf ) import GHC.Data.StringBuffer import qualified GHC.LanguageExtensions as LangExt @@ -336,12 +338,15 @@ warnMissingHomeModules dflags targets mod_graph = -> moduleName (ms_mod mod) == name && tuid == ms_unitid mod TargetFile target_file _ - | Just mod_file <- ml_hs_file (ms_location mod) + | Strict.Just mod_file <- ml_hs_file_ (ms_location mod) -> - augmentByWorkingDirectory dflags target_file == mod_file || + let + target_os_file = unsafeEncodeUtf target_file + in + augmentByWorkingDirectory dflags target_file == unsafeDecodeUtf mod_file || -- Don't warn on B.hs-boot if B.hs is specified (#16551) - addBootSuffix target_file == mod_file || + addBootSuffix target_os_file == mod_file || -- We can get a file target even if a module name was -- originally specified in a command line because it can @@ -1830,7 +1835,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf let dyn_tn = tn -<.> dynsuf addFilesToClean tmpfs dynLife [dyn_tn] - return (tn, dyn_tn) + return (unsafeEncodeUtf tn, unsafeEncodeUtf dyn_tn) -- We don't want to create .o or .hi files unless we have been asked -- to by the user. But we need them, so we patch their locations in -- the ModSummary with temporary files. @@ -1839,8 +1844,8 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- If ``-fwrite-interface` is specified, then the .o and .hi files -- are written into `-odir` and `-hidir` respectively. #16670 if gopt Opt_WriteInterface dflags - then return ((ml_hi_file ms_location, ml_dyn_hi_file ms_location) - , (ml_obj_file ms_location, ml_dyn_obj_file ms_location)) + then return ((ml_hi_file_ ms_location, ml_dyn_hi_file_ ms_location) + , (ml_obj_file_ ms_location, ml_dyn_obj_file_ ms_location)) else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) let new_dflags = case enable_spec of @@ -1849,10 +1854,10 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} let ms' = ms { ms_location = - ms_location { ml_hi_file = hi_file - , ml_obj_file = o_file - , ml_dyn_hi_file = dyn_hi_file - , ml_dyn_obj_file = dyn_o_file } + ms_location { ml_hi_file_ = hi_file + , ml_obj_file_ = o_file + , ml_dyn_hi_file_ = dyn_hi_file + , ml_dyn_obj_file_ = dyn_o_file } , ms_hspp_opts = updOptLevel 0 $ new_dflags } -- Recursive call to catch the other cases @@ -2037,7 +2042,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf let fopts = initFinderOpts (hsc_dflags hsc_env) -- Make a ModLocation for this file - let location = mkHomeModLocation fopts pi_mod_name src_fn + let location = mkHomeModLocation fopts pi_mod_name (unsafeEncodeUtf src_fn) -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Driver.Env import GHC.Driver.Errors.Types import qualified GHC.SysTools as SysTools import GHC.Data.Graph.Directed ( SCC(..) ) +import GHC.Data.OsPath (unsafeDecodeUtf) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SourceError @@ -297,7 +298,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do Found loc _ -- Home package: just depend on the .hi or hi-boot file | isJust (ml_hs_file loc) || include_pkg_deps - -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc))) + -> return (Just (unsafeDecodeUtf $ addBootSuffix_maybe is_boot (ml_hi_file_ loc))) -- Not in this package: we don't need a dependency | otherwise ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -58,6 +58,7 @@ import GHC.Iface.Make import GHC.Driver.Config.Parser import GHC.Parser.Header import GHC.Data.StringBuffer +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Types.SourceError import GHC.Unit.Finder import Data.IORef @@ -759,7 +760,7 @@ mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO Mod mkOneShotModLocation pipe_env dflags src_flavour mod_name = do let PipeEnv{ src_basename=basename, src_suffix=suff } = pipe_env - let location1 = mkHomeModLocation2 fopts mod_name basename suff + let location1 = mkHomeModLocation2 fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff) -- Boot-ify it if necessary let location2 @@ -771,11 +772,11 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do -- This can't be done in mkHomeModuleLocation because -- it only applies to the module being compiles let ohi = outputHi dflags - location3 | Just fn <- ohi = location2{ ml_hi_file = fn } + location3 | Just fn <- ohi = location2{ ml_hi_file_ = unsafeEncodeUtf fn } | otherwise = location2 let dynohi = dynOutputHi dflags - location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file = fn } + location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file_ = unsafeEncodeUtf fn } | otherwise = location3 -- Take -o into account if present @@ -789,10 +790,10 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do location5 | Just ofile <- expl_o_file , let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file , isNoLink (ghcLink dflags) - = location4 { ml_obj_file = ofile - , ml_dyn_obj_file = dyn_ofile } + = location4 { ml_obj_file_ = unsafeEncodeUtf ofile + , ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | Just dyn_ofile <- expl_dyn_o_file - = location4 { ml_dyn_obj_file = dyn_ofile } + = location4 { ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | otherwise = location4 return location5 where ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Utils.Panic.Plain import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Data.Maybe +import GHC.Data.OsPath import GHC.Prelude import GHC.Unit import GHC.Unit.Env @@ -55,13 +56,13 @@ cantFindInstalledErr unit_state mhome_unit profile mod_name find_result InstalledNotFound files mb_pkg | Just pkg <- mb_pkg , notHomeUnitId mhome_unit pkg - -> not_found_in_package pkg files + -> not_found_in_package pkg $ fmap unsafeDecodeUtf files | null files -> NotAModule | otherwise - -> CouldntFindInFiles files + -> CouldntFindInFiles $ fmap unsafeDecodeUtf files _ -> panic "cantFindInstalledErr" ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -42,6 +42,9 @@ import GHC.Platform.Ways import GHC.Builtin.Names ( gHC_PRIM ) +import qualified GHC.Data.Strict as Strict +import GHC.Data.OsPath + import GHC.Unit.Env import GHC.Unit.Types import GHC.Unit.Module @@ -49,7 +52,6 @@ import GHC.Unit.Home import GHC.Unit.State import GHC.Unit.Finder.Types -import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.ShortText as ST import GHC.Utils.Misc @@ -61,8 +63,7 @@ import GHC.Types.PkgQual import GHC.Fingerprint import Data.IORef -import System.Directory -import System.FilePath +import System.Directory.OsPath import Control.Monad import Data.Time import qualified Data.Map as M @@ -70,9 +71,10 @@ import GHC.Driver.Env ( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env) ) import GHC.Driver.Config.Finder import qualified Data.Set as Set +import qualified System.OsPath as OsPath -type FileExt = String -- Filename extension -type BaseName = String -- Basename of file +type FileExt = OsPath -- Filename extension +type BaseName = OsPath -- Basename of file -- ----------------------------------------------------------------------------- -- The Finder @@ -286,7 +288,7 @@ findLookupResult fc fopts r = case r of -- implicit locations from the instances InstalledFound loc _ -> return (Found loc m) InstalledNoPackage _ -> return (NoPackage (moduleUnit m)) - InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m) + InstalledNotFound fp _ -> return (NotFound{ fr_paths = fmap unsafeDecodeUtf fp, fr_pkg = Just (moduleUnit m) , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_unusables = [] @@ -357,7 +359,7 @@ findHomeModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -382,7 +384,7 @@ findHomePackageModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkModule uid mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -413,22 +415,22 @@ findInstalledHomeModule fc fopts home_unit mod_name = do let maybe_working_dir = finder_workingDirectory fopts home_path = case maybe_working_dir of - Nothing -> finder_importPaths fopts - Just fp -> augmentImports fp (finder_importPaths fopts) + Strict.Nothing -> finder_importPaths fopts + Strict.Just fp -> augmentImports fp (finder_importPaths fopts) hi_dir_path = case finder_hiDir fopts of - Just hiDir -> case maybe_working_dir of - Nothing -> [hiDir] - Just fp -> [fp hiDir] - Nothing -> home_path + Strict.Just hiDir -> case maybe_working_dir of + Strict.Nothing -> [hiDir] + Strict.Just fp -> [fp hiDir] + Strict.Nothing -> home_path hisuf = finder_hiSuf fopts mod = mkModule home_unit mod_name source_exts = - [ ("hs", mkHomeModLocationSearched fopts mod_name "hs") - , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs") - , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig") - , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig") + [ (unsafeEncodeUtf "hs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hs") + , (unsafeEncodeUtf "lhs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhs") + , (unsafeEncodeUtf "hsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hsig") + , (unsafeEncodeUtf "lhsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhsig") ] -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that @@ -453,9 +455,9 @@ findInstalledHomeModule fc fopts home_unit mod_name = do else searchPathExts search_dirs mod exts -- | Prepend the working directory to the search path. -augmentImports :: FilePath -> [FilePath] -> [FilePath] +augmentImports :: OsPath -> [OsPath] -> [OsPath] augmentImports _work_dir [] = [] -augmentImports work_dir (fp:fps) | isAbsolute fp = fp : augmentImports work_dir fps +augmentImports work_dir (fp:fps) | OsPath.isAbsolute fp = fp : augmentImports work_dir fps | otherwise = (work_dir fp) : augmentImports work_dir fps -- | Search for a module in external packages only. @@ -488,14 +490,14 @@ findPackageModule_ fc fopts mod pkg_conf = do tag = waysBuildTag (finder_ways fopts) -- hi-suffix for packages depends on the build tag. - package_hisuf | null tag = "hi" - | otherwise = tag ++ "_hi" + package_hisuf | null tag = unsafeEncodeUtf $ "hi" + | otherwise = unsafeEncodeUtf $ tag ++ "_hi" - package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" + package_dynhisuf = unsafeEncodeUtf $ waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf package_dynhisuf - import_dirs = map ST.unpack $ unitImportDirs pkg_conf + import_dirs = map (unsafeEncodeUtf . ST.unpack) $ unitImportDirs pkg_conf -- we never look for a .hi-boot file in an external package; -- .hi-boot files only make sense for the home package. in @@ -503,7 +505,7 @@ findPackageModule_ fc fopts mod pkg_conf = do [one] | finder_bypassHiFileCheck fopts -> -- there's only one place that this .hi file can be, so -- don't bother looking for it. - let basename = moduleNameSlashes (moduleName mod) + let basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) loc = mk_hi_loc one basename in return $ InstalledFound loc mod _otherwise -> @@ -512,24 +514,24 @@ findPackageModule_ fc fopts mod pkg_conf = do -- ----------------------------------------------------------------------------- -- General path searching -searchPathExts :: [FilePath] -- paths to search +searchPathExts :: [OsPath] -- paths to search -> InstalledModule -- module name -> [ ( FileExt, -- suffix - FilePath -> BaseName -> ModLocation -- action + OsPath -> BaseName -> ModLocation -- action ) ] -> IO InstalledFindResult searchPathExts paths mod exts = search to_search where - basename = moduleNameSlashes (moduleName mod) + basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) - to_search :: [(FilePath, ModLocation)] + to_search :: [(OsPath, ModLocation)] to_search = [ (file, fn path basename) | path <- paths, (ext,fn) <- exts, - let base | path == "." = basename + let base | path == unsafeEncodeUtf "." = basename | otherwise = path basename file = base <.> ext ] @@ -543,7 +545,7 @@ searchPathExts paths mod exts = search to_search else search rest mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt - -> FilePath -> BaseName -> ModLocation + -> OsPath -> BaseName -> ModLocation mkHomeModLocationSearched fopts mod suff path basename = mkHomeModLocation2 fopts mod (path basename) suff @@ -581,18 +583,18 @@ mkHomeModLocationSearched fopts mod suff path basename = -- ext -- The filename extension of the source file (usually "hs" or "lhs"). -mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation +mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> ModLocation mkHomeModLocation dflags mod src_filename = - let (basename,extension) = splitExtension src_filename + let (basename,extension) = OsPath.splitExtension src_filename in mkHomeModLocation2 dflags mod basename extension mkHomeModLocation2 :: FinderOpts -> ModuleName - -> FilePath -- Of source module, without suffix - -> String -- Suffix + -> OsPath -- Of source module, without suffix + -> OsPath -- Suffix -> ModLocation mkHomeModLocation2 fopts mod src_basename ext = - let mod_basename = moduleNameSlashes mod + let mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod obj_fn = mkObjPath fopts src_basename mod_basename dyn_obj_fn = mkDynObjPath fopts src_basename mod_basename @@ -600,72 +602,72 @@ mkHomeModLocation2 fopts mod src_basename ext = dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename hie_fn = mkHiePath fopts src_basename mod_basename - in (ModLocation{ ml_hs_file = Just (src_basename <.> ext), - ml_hi_file = hi_fn, - ml_dyn_hi_file = dyn_hi_fn, - ml_obj_file = obj_fn, - ml_dyn_obj_file = dyn_obj_fn, - ml_hie_file = hie_fn }) + in (ModLocation{ ml_hs_file_ = Strict.Just (src_basename <.> ext), + ml_hi_file_ = hi_fn, + ml_dyn_hi_file_ = dyn_hi_fn, + ml_obj_file_ = obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, + ml_hie_file_ = hie_fn }) mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName - -> FilePath + -> OsPath -> BaseName -> ModLocation mkHomeModHiOnlyLocation fopts mod path basename = - let loc = mkHomeModLocation2 fopts mod (path basename) "" - in loc { ml_hs_file = Nothing } + let loc = mkHomeModLocation2 fopts mod (path basename) mempty + in loc { ml_hs_file_ = Strict.Nothing } -- This function is used to make a ModLocation for a package module. Hence why -- we explicitly pass in the interface file suffixes. -mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String +mkHiOnlyModLocation :: FinderOpts -> OsPath -> OsPath -> OsPath -> OsPath -> ModLocation mkHiOnlyModLocation fopts hisuf dynhisuf path basename = let full_basename = path basename obj_fn = mkObjPath fopts full_basename basename dyn_obj_fn = mkDynObjPath fopts full_basename basename hie_fn = mkHiePath fopts full_basename basename - in ModLocation{ ml_hs_file = Nothing, - ml_hi_file = full_basename <.> hisuf, + in ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = full_basename <.> hisuf, -- Remove the .hi-boot suffix from -- hi_file, if it had one. We always -- want the name of the real .hi file -- in the ml_hi_file field. - ml_dyn_obj_file = dyn_obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, -- MP: TODO - ml_dyn_hi_file = full_basename <.> dynhisuf, - ml_obj_file = obj_fn, - ml_hie_file = hie_fn + ml_dyn_hi_file_ = full_basename <.> dynhisuf, + ml_obj_file_ = obj_fn, + ml_hie_file_ = hie_fn } -- | Constructs the filename of a .o file for a given source file. -- Does /not/ check whether the .o file exists mkObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath -mkObjPath fopts basename mod_basename = obj_basename <.> osuf + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath +mkObjPath fopts basename mod_basename = obj_basename OsPath.<.> osuf where odir = finder_objectDir fopts osuf = finder_objectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir OsPath. mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_o file for a given source file. -- Does /not/ check whether the .dyn_o file exists mkDynObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf where odir = finder_objectDir fopts dynosuf = finder_dynObjectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir mod_basename | otherwise = basename @@ -673,45 +675,45 @@ mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf -- Does /not/ check whether the .hi file exists mkHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiPath fopts basename mod_basename = hi_basename <.> hisuf where hidir = finder_hiDir fopts hisuf = finder_hiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_hi file for a given source file. -- Does /not/ check whether the .dyn_hi file exists mkDynHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf where hidir = finder_hiDir fopts dynhisuf = finder_dynHiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .hie file for a given source file. -- Does /not/ check whether the .hie file exists mkHiePath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf where hiedir = finder_hieDir fopts hiesuf = finder_hieSuf fopts - hie_basename | Just dir <- hiedir = dir mod_basename + hie_basename | Strict.Just dir <- hiedir = dir mod_basename | otherwise = basename @@ -726,23 +728,23 @@ mkStubPaths :: FinderOpts -> ModuleName -> ModLocation - -> FilePath + -> OsPath mkStubPaths fopts mod location = let stubdir = finder_stubDir fopts - mod_basename = moduleNameSlashes mod - src_basename = dropExtension $ expectJust "mkStubPaths" - (ml_hs_file location) + mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod + src_basename = OsPath.dropExtension $ Strict.expectJust "mkStubPaths" + (ml_hs_file_ location) stub_basename0 - | Just dir <- stubdir = dir mod_basename + | Strict.Just dir <- stubdir = dir mod_basename | otherwise = src_basename - stub_basename = stub_basename0 ++ "_stub" + stub_basename = stub_basename0 `mappend` unsafeEncodeUtf "_stub" in - stub_basename <.> "h" + stub_basename <.> unsafeEncodeUtf "h" -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -9,6 +9,7 @@ where import GHC.Prelude import GHC.Unit +import qualified GHC.Data.Strict as Strict import qualified Data.Map as M import GHC.Fingerprint import GHC.Platform.Ways @@ -16,6 +17,7 @@ import GHC.Platform.Ways import Data.IORef import GHC.Data.FastString import qualified Data.Set as Set +import System.OsPath (OsPath) -- | The 'FinderCache' maps modules to the result of -- searching for that module. It records the results of searching for @@ -31,7 +33,7 @@ data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState) data InstalledFindResult = InstalledFound ModLocation InstalledModule | InstalledNoPackage UnitId - | InstalledNotFound [FilePath] (Maybe UnitId) + | InstalledNotFound [OsPath] (Maybe UnitId) -- | The result of searching for an imported module. -- @@ -70,7 +72,7 @@ data FindResult -- -- Should be taken from 'DynFlags' via 'initFinderOpts'. data FinderOpts = FinderOpts - { finder_importPaths :: [FilePath] + { finder_importPaths :: [OsPath] -- ^ Where are we allowed to look for Modules and Source files , finder_lookupHomeInterfaces :: Bool -- ^ When looking up a home module: @@ -88,17 +90,17 @@ data FinderOpts = FinderOpts , finder_enableSuggestions :: Bool -- ^ If we encounter unknown modules, should we suggest modules -- that have a similar name. - , finder_workingDirectory :: Maybe FilePath + , finder_workingDirectory :: Strict.Maybe OsPath , finder_thisPackageName :: Maybe FastString , finder_hiddenModules :: Set.Set ModuleName , finder_reexportedModules :: Set.Set ModuleName - , finder_hieDir :: Maybe FilePath - , finder_hieSuf :: String - , finder_hiDir :: Maybe FilePath - , finder_hiSuf :: String - , finder_dynHiSuf :: String - , finder_objectDir :: Maybe FilePath - , finder_objectSuf :: String - , finder_dynObjectSuf :: String - , finder_stubDir :: Maybe FilePath + , finder_hieDir :: Strict.Maybe OsPath + , finder_hieSuf :: OsPath + , finder_hiDir :: Strict.Maybe OsPath + , finder_hiSuf :: OsPath + , finder_dynHiSuf :: OsPath + , finder_objectDir :: Strict.Maybe OsPath + , finder_objectSuf :: OsPath + , finder_dynObjectSuf :: OsPath + , finder_stubDir :: Strict.Maybe OsPath } deriving Show ===================================== compiler/GHC/Unit/Module/Location.hs ===================================== @@ -7,10 +7,19 @@ module GHC.Unit.Module.Location , addBootSuffixLocn , addBootSuffixLocnOut , removeBootSuffix + , ml_hs_file + , ml_hi_file + , ml_dyn_hi_file + , ml_obj_file + , ml_dyn_obj_file + , ml_hie_file ) where import GHC.Prelude + +import GHC.Data.OsPath +import qualified GHC.Data.Strict as Strict import GHC.Unit.Types import GHC.Utils.Outputable @@ -39,30 +48,30 @@ import GHC.Utils.Outputable data ModLocation = ModLocation { - ml_hs_file :: Maybe FilePath, + ml_hs_file_ :: Strict.Maybe OsPath, -- ^ The source file, if we have one. Package modules -- probably don't have source files. - ml_hi_file :: FilePath, + ml_hi_file_ :: OsPath, -- ^ Where the .hi file is, whether or not it exists -- yet. Always of form foo.hi, even if there is an -- hi-boot file (we add the -boot suffix later) - ml_dyn_hi_file :: FilePath, + ml_dyn_hi_file_ :: OsPath, -- ^ Where the .dyn_hi file is, whether or not it exists -- yet. - ml_obj_file :: FilePath, + ml_obj_file_ :: OsPath, -- ^ Where the .o file is, whether or not it exists yet. -- (might not exist either because the module hasn't -- been compiled yet, or because it is part of a -- unit with a .a file) - ml_dyn_obj_file :: FilePath, + ml_dyn_obj_file_ :: OsPath, -- ^ Where the .dy file is, whether or not it exists -- yet. - ml_hie_file :: FilePath + ml_hie_file_ :: OsPath -- ^ Where the .hie file is, whether or not it exists -- yet. } deriving Show @@ -71,8 +80,8 @@ instance Outputable ModLocation where ppr = text . show -- | Add the @-boot@ suffix to .hs, .hi and .o files -addBootSuffix :: FilePath -> FilePath -addBootSuffix path = path ++ "-boot" +addBootSuffix :: OsPath -> OsPath +addBootSuffix path = path `mappend` unsafeEncodeUtf "-boot" -- | Remove the @-boot@ suffix to .hs, .hi and .o files removeBootSuffix :: FilePath -> FilePath @@ -82,7 +91,7 @@ removeBootSuffix [] = error "removeBootSuffix: no -boot suffix" -- | Add the @-boot@ suffix if the @Bool@ argument is @True@ -addBootSuffix_maybe :: IsBootInterface -> FilePath -> FilePath +addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath addBootSuffix_maybe is_boot path = case is_boot of IsBoot -> addBootSuffix path NotBoot -> path @@ -95,22 +104,42 @@ addBootSuffixLocn_maybe is_boot locn = case is_boot of -- | Add the @-boot@ suffix to all file paths associated with the module addBootSuffixLocn :: ModLocation -> ModLocation addBootSuffixLocn locn - = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn) - , ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) } + = locn { ml_hs_file_ = fmap addBootSuffix (ml_hs_file_ locn) + , ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } -- | Add the @-boot@ suffix to all output file paths associated with the -- module, not including the input file itself addBootSuffixLocnOut :: ModLocation -> ModLocation addBootSuffixLocnOut locn - = locn { ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) + = locn { ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } +-- ---------------------------------------------------------------------------- +-- Helpers for backwards compatibility +-- ---------------------------------------------------------------------------- + +ml_hs_file :: ModLocation -> Maybe FilePath +ml_hs_file = fmap unsafeDecodeUtf . Strict.toLazy . ml_hs_file_ + +ml_hi_file :: ModLocation -> FilePath +ml_hi_file = unsafeDecodeUtf . ml_hi_file_ + +ml_dyn_hi_file :: ModLocation -> FilePath +ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ + +ml_obj_file :: ModLocation -> FilePath +ml_obj_file = unsafeDecodeUtf . ml_obj_file_ + +ml_dyn_obj_file :: ModLocation -> FilePath +ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ +ml_hie_file :: ModLocation -> FilePath +ml_hie_file = unsafeDecodeUtf . ml_hie_file_ ===================================== compiler/ghc.cabal.in ===================================== @@ -428,6 +428,7 @@ Library GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList + GHC.Data.OsPath GHC.Data.Pair GHC.Data.SmallArray GHC.Data.Stream ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -69,6 +69,7 @@ GHC.Data.List.Infinite GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList +GHC.Data.OsPath GHC.Data.Pair GHC.Data.Strict GHC.Data.StringBuffer ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -70,6 +70,7 @@ GHC.Data.List.Infinite GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList +GHC.Data.OsPath GHC.Data.Pair GHC.Data.Strict GHC.Data.StringBuffer ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe +Subproject commit 1ef6c187b31f85dfd7133b150b211ec9140cc84a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2622622f9be367bda8740c7fcbb578dede2f9c55 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2622622f9be367bda8740c7fcbb578dede2f9c55 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 10:34:43 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 03 Apr 2024 06:34:43 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 2 commits: fixup! rts: lookupSymbolInNativeObj in Windows Message-ID: <660d30c3df713_4ce5c49fdb8621e9@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: d6f0aa80 by Rodrigo Mesquita at 2024-04-03T11:34:30+01:00 fixup! rts: lookupSymbolInNativeObj in Windows - - - - - afebba1e by Rodrigo Mesquita at 2024-04-03T11:34:31+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 9 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -634,6 +634,7 @@ internal_dlsym(const char *symbol) { // we failed to find the symbol return NULL; } +# endif void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { @@ -643,16 +644,20 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; } -# endif const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,19 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { - IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1884,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,7 +1,10 @@ -#include "CheckUnload.h" -#include "ForeignExports.h" #include "LinkerInternals.h" #include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" #include "RtsUtils.h" #include "Profiling.h" @@ -208,4 +211,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1017,7 +1017,10 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f stgFree(dllName); IF_DEBUG(linker, debugBelch("loadArchive: read symbol %s from lib `%" PATH_FMT "'\n", symbol, dll)); - const char* result = addDLL(dll); + // We must call `addDLL_PEi386` directly rather than `addDLL` because `addDLL` + // is now a wrapper around `loadNativeObj` which acquires a lock which we + // already have here. + const char* result = addDLL_PEi386(dll, NULL); stgFree(image); @@ -1141,47 +1144,57 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; + SymbolAddr* res; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + if (!(res = lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent))) + return res; + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name STG_UNUSED, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+STRIP_LEADING_UNDERSCORE,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0bca53c232f1b65fb49d7b1c89bb553346ff4032...afebba1e237fd597ac452b342ac2f359715e77d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0bca53c232f1b65fb49d7b1c89bb553346ff4032...afebba1e237fd597ac452b342ac2f359715e77d4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 10:37:01 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 03 Apr 2024 06:37:01 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 2 commits: fixup! rts: lookupSymbolInNativeObj in Windows Message-ID: <660d314deba50_4ce5c593b986247c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 07d9215b by Rodrigo Mesquita at 2024-04-03T11:36:48+01:00 fixup! rts: lookupSymbolInNativeObj in Windows - - - - - f821f42c by Rodrigo Mesquita at 2024-04-03T11:36:49+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 9 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -634,6 +634,7 @@ internal_dlsym(const char *symbol) { // we failed to find the symbol return NULL; } +# endif void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { @@ -643,16 +644,20 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; } -# endif const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,19 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { - IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1884,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,7 +1,10 @@ -#include "CheckUnload.h" -#include "ForeignExports.h" #include "LinkerInternals.h" #include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" #include "RtsUtils.h" #include "Profiling.h" @@ -208,4 +211,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1017,7 +1017,10 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f stgFree(dllName); IF_DEBUG(linker, debugBelch("loadArchive: read symbol %s from lib `%" PATH_FMT "'\n", symbol, dll)); - const char* result = addDLL(dll); + // We must call `addDLL_PEi386` directly rather than `addDLL` because `addDLL` + // is now a wrapper around `loadNativeObj` which acquires a lock which we + // already have here. + const char* result = addDLL_PEi386(dll, NULL); stgFree(image); @@ -1141,47 +1144,57 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; + SymbolAddr* res; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + if (res = lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent)) + return res; + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name STG_UNUSED, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+STRIP_LEADING_UNDERSCORE,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/afebba1e237fd597ac452b342ac2f359715e77d4...f821f42c7f1ca417128a148c1bcaee222437f8ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/afebba1e237fd597ac452b342ac2f359715e77d4...f821f42c7f1ca417128a148c1bcaee222437f8ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 10:38:17 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 03 Apr 2024 06:38:17 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 2 commits: fixup! rts: lookupSymbolInNativeObj in Windows Message-ID: <660d3199521cf_4ce5c6a9dd46275@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 46813433 by Rodrigo Mesquita at 2024-04-03T11:38:03+01:00 fixup! rts: lookupSymbolInNativeObj in Windows - - - - - 8e59449e by Rodrigo Mesquita at 2024-04-03T11:38:03+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 9 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - rts/Linker.c - rts/linker/LoadNativeObjPosix.c - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== rts/Linker.c ===================================== @@ -634,6 +634,7 @@ internal_dlsym(const char *symbol) { // we failed to find the symbol return NULL; } +# endif void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { @@ -643,16 +644,20 @@ void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif RELEASE_LOCK(&linker_mutex); return result; } -# endif const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) char *errmsg; if (loadNativeObj(dll_name, &errmsg)) { return NULL; @@ -660,13 +665,6 @@ const char *addDLL(pathchar* dll_name) ASSERT(errmsg != NULL); return errmsg; } - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1861,12 +1859,19 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void * loadNativeObj (pathchar *path, char **errmsg) { - IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%s'\n", path)); + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); +#else + barf("loadNativeObj: not implemented on this platform"); +#endif #if defined(OBJFORMAT_ELF) if (!r) { @@ -1879,15 +1884,6 @@ void * loadNativeObj (pathchar *path, char **errmsg) RELEASE_LOCK(&linker_mutex); return r; } -#else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); - barf("loadNativeObj: not implemented on this platform"); -} -#endif static HsInt unloadNativeObj_(void *handle) { ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -1,7 +1,10 @@ -#include "CheckUnload.h" -#include "ForeignExports.h" #include "LinkerInternals.h" #include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" #include "RtsUtils.h" #include "Profiling.h" @@ -208,4 +211,4 @@ success: return retval; } - +#endif /* elf + macho */ ===================================== rts/linker/PEi386.c ===================================== @@ -1017,7 +1017,10 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f stgFree(dllName); IF_DEBUG(linker, debugBelch("loadArchive: read symbol %s from lib `%" PATH_FMT "'\n", symbol, dll)); - const char* result = addDLL(dll); + // We must call `addDLL_PEi386` directly rather than `addDLL` because `addDLL` + // is now a wrapper around `loadNativeObj` which acquires a lock which we + // already have here. + const char* result = addDLL_PEi386(dll, NULL); stgFree(image); @@ -1141,47 +1144,57 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; + SymbolAddr* res; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + if ((res = lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent))) + return res; + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name STG_UNUSED, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl+STRIP_LEADING_UNDERSCORE,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f821f42c7f1ca417128a148c1bcaee222437f8ad...8e59449effd9630750533bf536a975eff1b7b6e8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f821f42c7f1ca417128a148c1bcaee222437f8ad...8e59449effd9630750533bf536a975eff1b7b6e8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 11:03:30 2024 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Wed, 03 Apr 2024 07:03:30 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Implement Or Patterns (#22596) Message-ID: <660d3782743d4_4ce5ca096f067070@gitlab.mail> Sebastian Graf pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: df358de7 by David Knothe at 2024-04-03T13:03:07+02:00 Implement Or Patterns (#22596) This commit introduces a new language extension, `-XOrPatterns`, as described in GHC Proposal 522. An or-pattern `pat1; ...; patk` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. See also the summary `Note [Implmentation of OrPatterns]`. Co-Authored-By: Sebastian Graf <sgraf1337 at gmail.com> - - - - - 30 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - + docs/users_guide/exts/or_patterns.rst - docs/users_guide/exts/patterns.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - + testsuite/tests/deSugar/should_run/Or5.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df358de773d27609d1da7ce3a3afe7d322c844e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df358de773d27609d1da7ce3a3afe7d322c844e9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 11:04:52 2024 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Wed, 03 Apr 2024 07:04:52 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Implement Or Patterns (#22596) Message-ID: <660d37d493b5e_4ce5cad6f3868251@gitlab.mail> Sebastian Graf pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 2bfed745 by David Knothe at 2024-04-03T13:04:46+02:00 Implement Or Patterns (#22596) This commit introduces a new language extension, `-XOrPatterns`, as described in GHC Proposal 522. An or-pattern `pat1; ...; patk` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. See also the summary `Note [Implmentation of OrPatterns]`. Co-Authored-By: Sebastian Graf <sgraf1337 at gmail.com> - - - - - 30 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - + docs/users_guide/exts/or_patterns.rst - docs/users_guide/exts/patterns.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - + testsuite/tests/deSugar/should_run/Or5.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bfed745a67e4b461db8ccb241bc734996972e3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bfed745a67e4b461db8ccb241bc734996972e3f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 11:58:26 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Wed, 03 Apr 2024 07:58:26 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] 2 commits: Refactor the Binary serialisation interface Message-ID: <660d4462d6bbe_4ce5c11c74c87947d@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: 413b0ba9 by Fendor at 2024-04-03T13:57:05+02:00 Refactor the Binary serialisation interface The end goal is to dynamically add deduplication tables for `ModIface` interface serialisation. We identify two main points of interest that make this difficult: 1. UserData hardcodes what `Binary` instances can have deduplication tables. Moreover, it heavily uses partial functions. 2. GHC.Iface.Binary hardcodes the deduplication tables for 'Name' and 'FastString', making it difficult to add more deduplication. Instead of having a single `UserData` record with fields for all the types that can have deduplication tables, we allow to provide custom serialisers for any `Typeable`. These are wrapped in existentials and stored in a `Map` indexed by their respective `TypeRep`. The `Binary` instance of the type to deduplicate still needs to explicitly look up the decoder via `findUserDataReader` and `findUserDataWriter`, which is no worse than the status-quo. `Map` was chosen as microbenchmarks indicate it is the fastest for a small number of keys (< 10). To generalise the deduplication table serialisation mechanism, we introduce the types `ReaderTable` and `WriterTable` which provide a simple interface that is sufficient to implement a general purpose deduplication mechanism for `writeBinIface` and `readBinIface`. This allows us to provide a list of deduplication tables for serialisation that can be extended more easily, for example for `IfaceTyCon`, see the issue https://gitlab.haskell.org/ghc/ghc/-/issues/24540 for more motivation. In addition to ths refactoring, we split `UserData` into `ReaderUserData` and `WriterUserData`, to avoid partial functions. Bump haddock submodule to accomodate for `UserData` split. - - - - - 54a9bfea by Fendor at 2024-04-03T13:57:58+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 13 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -29,7 +29,6 @@ module GHC.Iface.Binary ( import GHC.Prelude -import GHC.Tc.Utils.Monad import GHC.Builtin.Utils ( isKnownKeyName, lookupKnownKeyName ) import GHC.Unit import GHC.Unit.Module.ModIface @@ -54,6 +53,9 @@ import Data.Char import Data.Word import Data.IORef import Control.Monad +import Data.Functor.Identity +import Data.Bifunctor (Bifunctor(second)) +import Data.Coerce -- --------------------------------------------------------------------------- -- Reading and writing binary interface files @@ -75,7 +77,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -121,6 +123,8 @@ readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do pure (src_hash, bh) -- | Read an interface file. +-- +-- See Note [Iface Binary Serialisation] for details. readBinIface :: Profile -> NameCache @@ -135,7 +139,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -146,7 +150,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -154,24 +158,33 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do - -- Read the dictionary - -- The next word in the file is a pointer to where the dictionary is - -- (probably at the end of the file) - dict <- Binary.forwardGet bh (getDictionary bh) - - -- Initialise the user-data field of bh - let bh_fs = setUserData bh $ newReadState (error "getSymtabName") - (getDictFastString dict) - - symtab <- Binary.forwardGet bh_fs (getSymbolTable bh_fs name_cache) - - -- It is only now that we know how to get a Name - return $ setUserData bh $ newReadState (getSymtabName name_cache dict symtab) - (getDictFastString dict) - --- | Write an interface file + let + -- The order of these entries matters! + -- + -- See Note [Iface Binary Serialiser Order] for details. + tables :: [SomeReaderTable IO] + tables = + [ SomeReaderTable initFastStringReaderTable + , SomeReaderTable (initReadNameCachedBinary name_cache) + , SomeReaderTable @IO @NonBindingName (coerce (initReadNameCachedBinary name_cache)) + ] + + tables <- traverse (\(SomeReaderTable tblM) -> tblM >>= pure . SomeReaderTable . pure) tables + + final_bh <- foldM (\bh (SomeReaderTable (tbl' :: Identity (ReaderTable a))) -> do + let tbl = runIdentity tbl' + res <- Binary.forwardGet bh (getTable tbl bh) + let newDecoder = mkReaderFromTable tbl res + pure $ addReaderToUserData (mkSomeBinaryReader newDecoder) bh + ) bh tables + + pure final_bh + +-- | Write an interface file. +-- +-- See Note [Iface Binary Serialisation] for details. writeBinIface :: Profile -> TraceBinIFace -> FilePath -> ModIface -> IO () writeBinIface profile traceBinIface hi_path mod_iface = do bh <- openBinMem initBinMemSize @@ -184,14 +197,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -201,7 +214,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -225,43 +238,40 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int,Int,b) -putWithTables bh put_payload = do - -- initialize state for the name table and the FastString table. - symtab_next <- newFastMutInt 0 - symtab_map <- newIORef emptyUFM - let bin_symtab = BinSymbolTable - { bin_symtab_next = symtab_next - , bin_symtab_map = symtab_map - } - - (bh_fs, bin_dict, put_dict) <- initFSTable bh - - (fs_count,(name_count,r)) <- forwardPut bh (const put_dict) $ do - - -- NB. write the dictionary after the symbol table, because - -- writing the symbol table may create more dictionary entries. - let put_symtab = do - name_count <- readFastMutInt symtab_next - symtab_map <- readIORef symtab_map - putSymbolTable bh_fs name_count symtab_map - pure name_count - - forwardPut bh_fs (const put_symtab) $ do - - -- BinHandle with FastString and Name writing support - let ud_fs = getUserData bh_fs - let ud_name = ud_fs - { ud_put_nonbinding_name = putName bin_dict bin_symtab - , ud_put_binding_name = putName bin_dict bin_symtab - } - let bh_name = setUserData bh ud_name - - put_payload bh_name - - return (name_count, fs_count, r) - - +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) +putWithTables bh' put_payload = do + let + -- The order of these entries matters! + -- + -- See Note [Iface Binary Serialiser Order] for details. + writerTables = + [ SomeWriterTable initFastStringWriterTable + , SomeWriterTable initWriteNameTable + , SomeWriterTable (fmap (second (\(BinaryWriter f) -> BinaryWriter (\bh name -> f bh (getNonBindingName name)))) initWriteNameTable) + ] + + tables <- traverse (\(SomeWriterTable worker) -> worker >>= pure . SomeWriterTable . pure) writerTables + + let writerUserData = + mkWriterUserData $ + map + (\(SomeWriterTable tbl') -> mkSomeBinaryWriter (snd $ runIdentity tbl')) + tables + + let bh = setWriterUserData bh' writerUserData + (fs_count : name_count : _, r) <- + putAllTables bh (fmap (\(SomeWriterTable tbl) -> fst $ runIdentity tbl) tables) $ do + put_payload bh + + return (name_count, fs_count, r) + where + putAllTables _ [] act = do + a <- act + pure ([], a) + putAllTables bh (x : xs) act = do + (r, (res, a)) <- forwardPut bh (const $ putTable x bh) $ do + putAllTables bh xs act + pure (r : res, a) -- | Initial ram buffer to allocate for writing interface files initBinMemSize :: Int @@ -273,11 +283,108 @@ binaryInterfaceMagic platform | otherwise = FixedLengthEncoding 0x1face64 +{- +Note [Iface Binary Serialisation] +~~~~~~~~~~~~~~~~~~~ +When we serialise a 'ModIface', many symbols are redundant. +For example, there can be duplicated 'FastString's and 'Name's. +To save space, we deduplicate some symbols, such as 'FastString' and 'Name', +by maintaining a table of already seen symbols. +When serialising a symbol, we lookup whether we have encountered the symbol before. +If yes, we write the index of the symbol, otherwise we generate a new index and store it in the table. + +Besides saving a lot of disk space, this additionally enables us to automatically share +these symbols when we read the 'ModIface' from disk, without additional mechanisms such as 'FastStringTable'. + +Note [Iface Binary Serialiser Order] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Serialisation of 'ModIface' uses tables to deduplicate symbols that occur often. + +After 'ModIface' has been written to disk, we write the deduplication tables. +Writing a table may add additional entries to *other* deduplication tables, thus +we need to make sure that the symbol table we serialise only depends on +deduplication tables that haven't been written to disk yet. + +For example, assume we maintain deduplication tables for 'FastString' and 'Name'. +The symbol 'Name' depends on 'FastString', so serialising a 'Name' may add a 'FastString' +to the 'FastString' deduplication table. +Thus, 'Name' table needs to be serialised to disk before the 'FastString' table. + +When we read the 'ModIface' from disk, we consequentially need to read the 'FastString' +deduplication table from disk, before we can deserialise the 'Name' deduplication table. +Therefore, before we serialise the tables, we write forward pointers that allow us to jump ahead +to the table we need to deserialise first. + +Here, a visualisation of the table structure we currently have: + +┌──────────────┐ +│ Headers │ +├──────────────┤ +│ │ +│ ModIface │ +│ Payload │ +│ │ +├──────────────┤ +│ Ptr FS ├───────────┐ +├──────────────┤ │ +│ Ptr Name ├────────┐ │ +├──────────────┤ │ │ +│ │ │ │ +│ Name Table │◄───────┘ │ +│ │ │ +├──────────────┤ │ +│ │ │ +│ FS Table │◄──────────┘ +│ │ +└──────────────┘ + +-} + + -- ----------------------------------------------------------------------------- -- The symbol table -- -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () + +initReadNameCachedBinary :: NameCache -> IO (ReaderTable Name) +initReadNameCachedBinary cache = do + return $ + ReaderTable + { getTable = \bh -> getSymbolTable bh cache + , mkReaderFromTable = \tbl -> mkReader (getSymtabName tbl) + } + +data BinSymbolTable = BinSymbolTable { + bin_symtab_next :: !FastMutInt, -- The next index to use + bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) + -- indexed by Name + } + +initWriteNameTable :: IO (WriterTable, BinaryWriter Name) +initWriteNameTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef emptyUFM + let bin_symtab = + BinSymbolTable + { bin_symtab_next = symtab_next + , bin_symtab_map = symtab_map + } + + let put_symtab bh = do + name_count <- readFastMutInt symtab_next + symtab_map <- readIORef symtab_map + putSymbolTable bh name_count symtab_map + pure name_count + + return + ( WriterTable + { putTable = put_symtab + } + , mkWriter $ putName bin_symtab + ) + + +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -286,7 +393,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -307,7 +414,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -331,8 +438,8 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: FSTable -> BinSymbolTable -> BinHandle -> Name -> IO () -putName _dict BinSymbolTable{ +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () +putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } bh name @@ -356,10 +463,9 @@ putName _dict BinSymbolTable{ put_ bh (fromIntegral off :: Word32) -- See Note [Symbol table representation of names] -getSymtabName :: NameCache - -> Dictionary -> SymbolTable - -> BinHandle -> IO Name -getSymtabName _name_cache _dict symtab bh = do +getSymtabName :: SymbolTable Name + -> ReadBinHandle -> IO Name +getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of 0x00000000 -> return $! symtab ! fromIntegral i @@ -376,10 +482,3 @@ getSymtabName _name_cache _dict symtab bh = do Just n -> n _ -> pprPanic "getSymtabName:unknown name tag" (ppr i) - -data BinSymbolTable = BinSymbolTable { - bin_symtab_next :: !FastMutInt, -- The next index to use - bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) - -- indexed by Name - } - ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -105,15 +105,16 @@ writeHieFile hie_file_path hiefile = do hie_dict_map = dict_map_ref } -- put the main thing - let bh = setUserData bh0 $ newWriteState (putName hie_symtab) - (putName hie_symtab) - (putFastString hie_dict) + let bh = setWriterUserData bh0 + $ newWriteState (putName hie_symtab) + (putName hie_symtab) + (putFastString hie_dict) put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next @@ -121,9 +122,9 @@ writeHieFile hie_file_path hiefile = do putSymbolTable bh symtab_next' symtab_map' -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -181,7 +182,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -190,7 +191,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -213,15 +214,16 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data bh1 <- do - let bh1 = setUserData bh0 $ newReadState (error "getSymtabName") - (getDictFastString dict) + let bh1 = setReaderUserData bh0 + $ newReadState (error "getSymtabName") + (getDictFastString dict) symtab <- get_symbol_table bh1 - let bh1' = setUserData bh1 + let bh1' = setReaderUserData bh1 $ newReadState (getSymTabName symtab) (getDictFastString dict) return bh1' @@ -231,21 +233,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -259,13 +261,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -275,12 +277,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -333,7 +335,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -344,7 +346,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -35,11 +35,11 @@ computeFingerprint put_nonbinding_name a = do fingerprintBinMem bh where set_user_data bh = - setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS + setWriterUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith, import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Proxy infixl 3 &&& @@ -118,15 +119,15 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = - case getUserData bh of - UserData{ ud_put_binding_name = put_binding_name } -> + case findUserDataWriter Proxy bh of + tbl -> --pprTrace "putIfaceTopBndr" (ppr name) $ - put_binding_name bh name + putEntry tbl bh name data IfaceDecl @@ -2444,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -9,7 +9,6 @@ This module defines interface types and binders {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE LambdaCase #-} - module GHC.Iface.Type ( IfExtName, IfLclName, @@ -90,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ @@ -2045,11 +2044,12 @@ instance Outputable IfaceCoercion where ppr = pprIfaceCoercion instance Binary IfaceTyCon where - put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i + put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i - get bh = do n <- get bh - i <- get bh - return (IfaceTyCon n i) + get bh = do + n <- get bh + i <- get bh + return (IfaceTyCon n i) instance Binary IfaceTyConSort where put_ bh IfaceNormalTyCon = putByte bh 0 ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -66,6 +66,9 @@ import GHC.Prelude import Control.Monad import Data.Array +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import Data.Char (isSpace) import Data.Int import Data.IntSet (IntSet) import qualified Data.IntSet as IS @@ -75,10 +78,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Word import Data.Semigroup -import qualified Data.ByteString as B -import qualified Data.ByteString.Unsafe as B -import Data.Char (isSpace) -import System.IO +import System.IO import GHC.Settings.Constants (hiVersion) @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -313,15 +313,16 @@ putObject bh mod_name deps os = do -- object in an archive. put_ bh (moduleNameString mod_name) - (bh_fs, _bin_dict, put_dict) <- initFSTable bh + (fs_tbl, fs_writer) <- initFastStringWriterTable + let bh_fs = addWriterToUserData (mkSomeBinaryWriter fs_writer) bh - forwardPut_ bh (const put_dict) $ do + forwardPut_ bh (const (putTable fs_tbl bh_fs)) $ do put_ bh_fs deps -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -329,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -344,15 +345,15 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) - let bh = setUserData bh0 $ noUserData { ud_get_fs = getDictFastString dict } + let bh = setReaderUserData bh0 $ newReadState (panic "No name allowed") (getDictFastString dict) block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -363,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -392,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -408,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -778,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -1010,7 +1010,7 @@ data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple - deriving( Eq, Data ) + deriving( Eq, Data, Ord ) instance Outputable TupleSort where ppr ts = text $ ===================================== compiler/GHC/Types/FieldLabel.hs ===================================== @@ -140,14 +140,14 @@ instance Binary Name => Binary FieldLabel where put_ bh (FieldLabel aa ab ac) = do put_ bh aa put_ bh ab - case getUserData bh of - UserData{ ud_put_binding_name = put_binding_name } -> - put_binding_name bh ac + case findUserDataWriter Proxy bh of + tbl -> putEntry tbl bh (NonBindingName ac) get bh = do aa <- get bh ab <- get bh - ac <- get bh - return (FieldLabel aa ab ac) + ac <- case findUserDataReader Proxy bh of + tbl -> getEntry tbl bh + return (FieldLabel aa ab $ getNonBindingName ac) flIsOverloaded :: FieldLabel -> Bool flIsOverloaded fl = ===================================== compiler/GHC/Types/Name.hs ===================================== @@ -663,12 +663,12 @@ instance Data Name where -- distinction. instance Binary Name where put_ bh name = - case getUserData bh of - UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name + case findUserDataWriter Proxy bh of + tbl -> putEntry tbl bh name get bh = - case getUserData bh of - UserData { ud_get_name = get_name } -> get_name bh + case findUserDataReader Proxy bh of + tbl -> getEntry tbl bh {- ************************************************************************ ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -4,6 +4,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-} +{-# LANGUAGE TypeFamilies #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected @@ -21,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -30,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -66,15 +69,30 @@ module GHC.Utils.Binary lazyPutMaybe, -- * User data - UserData(..), getUserData, setUserData, - newReadState, newWriteState, noUserData, - + ReaderUserData(..), getReaderUserData, setReaderUserData, noReaderUserData, + WriterUserData(..), getWriterUserData, setWriterUserData, noWriterUserData, + mkWriterUserData, mkReaderUserData, + newReadState, newWriteState, + addReaderToUserData, addWriterToUserData, + findUserDataReader, findUserDataWriter, + -- * Binary Readers & Writers + BinaryReader(..), BinaryWriter(..), + mkWriter, mkReader, + SomeBinaryReader, SomeBinaryWriter, + mkSomeBinaryReader, mkSomeBinaryWriter, + -- * Tables + SomeReaderTable(..), + ReaderTable(..), + SomeWriterTable(..), + WriterTable(..), -- * String table ("dictionary") + initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, - FSTable, initFSTable, getDictFastString, putDictFastString, - + FSTable(..), getDictFastString, putDictFastString, -- * Newtype wrappers - BinSpan(..), BinSrcSpan(..), BinLocated(..) + BinSpan(..), BinSrcSpan(..), BinLocated(..), + -- * Newtypes for types that have canonically more than one valid encoding + NonBindingName(..), ) where import GHC.Prelude @@ -93,6 +111,7 @@ import qualified GHC.Data.Strict as Strict import GHC.Utils.Outputable( JoinPointHood(..) ) import Control.DeepSeq +import Control.Monad ( when, (<$!>), unless, forM_, void ) import Foreign hiding (shiftL, shiftR, void) import Data.Array import Data.Array.IO @@ -104,11 +123,13 @@ import Data.IORef import Data.Char ( ord, chr ) import Data.List.NonEmpty ( NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Data.Set ( Set ) import qualified Data.Set as Set import Data.Time import Data.List (unfoldr) -import Control.Monad ( when, (<$!>), unless, forM_, void ) +import Data.Typeable import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Error ( mkIOError, eofErrorType ) @@ -119,6 +140,9 @@ import qualified Data.IntMap as IntMap import GHC.ForeignPtr ( unsafeWithForeignPtr ) #endif +import Unsafe.Coerce (unsafeCoerce) +import Data.Coerce + type BinArray = ForeignPtr Word8 #if !MIN_VERSION_base(4,15,0) @@ -150,49 +174,83 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_usr :: UserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: !WriterUserData, + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getUserData :: BinHandle -> UserData -getUserData bh = bh_usr bh +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: !ReaderUserData, + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) + } + +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh + +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setUserData :: BinHandle -> UserData -> BinHandle -setUserData bh us = bh { bh_usr = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } + +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } + +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle +addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) + } + } + +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle +addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) + } + } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -211,23 +269,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -235,42 +293,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } + +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -279,20 +352,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -313,7 +389,7 @@ expandBin (BinMem _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -329,7 +405,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -350,8 +426,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -372,39 +448,37 @@ putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -412,7 +486,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -425,7 +499,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -437,7 +511,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -458,10 +532,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -484,15 +558,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -509,15 +583,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -533,15 +607,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -561,15 +635,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -980,63 +1054,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1044,14 +1118,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1062,7 +1136,9 @@ lazyGetMaybe bh = do -- UserData -- ----------------------------------------------------------------------------- --- | Information we keep around during interface file +-- Note [Binary UserData] +-- ~~~~~~~~~~~~~~~~~~~~~~ +-- Information we keep around during interface file -- serialization/deserialization. Namely we keep the functions for serializing -- and deserializing 'Name's and 'FastString's. We do this because we actually -- use serialization in two distinct settings, @@ -1081,73 +1157,197 @@ lazyGetMaybe bh = do -- non-binding Name is serialized as the fingerprint of the thing they -- represent. See Note [Fingerprinting IfaceDecls] for further discussion. -- -data UserData = - UserData { - -- for *deserialising* only: - ud_get_name :: BinHandle -> IO Name, - ud_get_fs :: BinHandle -> IO FastString, - - -- for *serialising* only: - ud_put_nonbinding_name :: BinHandle -> Name -> IO (), - -- ^ serialize a non-binding 'Name' (e.g. a reference to another - -- binding). - ud_put_binding_name :: BinHandle -> Name -> IO (), - -- ^ serialize a binding 'Name' (e.g. the name of an IfaceDecl) - ud_put_fs :: BinHandle -> FastString -> IO () + +-- | Newtype to serialise non-binding names differently to 'Name'. +-- See Note [Binary UserData] +newtype NonBindingName = NonBindingName { getNonBindingName :: Name } + deriving ( Eq ) + +-- | Existential for 'BinaryWriter' with a type witness. +data SomeBinaryWriter = forall a . SomeBinaryWriter TypeRep (BinaryWriter a) + +-- | Existential for 'BinaryReader' with a type witness. +data SomeBinaryReader = forall a . SomeBinaryReader TypeRep (BinaryReader a) + +-- | UserData required to serialise symbols for interface files. +-- +-- See Note [Binary UserData] +data WriterUserData = + WriterUserData { + ud_writer_data :: Map TypeRep SomeBinaryWriter + -- ^ A mapping from a type witness to the 'Writer' for the associated type. + -- This is a 'Map' because microbenchmarks indicated this is more efficient + -- than other representations for less than ten elements. + -- + -- Considered representations: + -- + -- * [(TypeRep, SomeBinaryWriter)] + -- * bytehash (on hackage) + -- * Map TypeRep SomeBinaryWriter } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) - -> UserData -newReadState get_name get_fs - = UserData { ud_get_name = get_name, - ud_get_fs = get_fs, - ud_put_nonbinding_name = undef "put_nonbinding_name", - ud_put_binding_name = undef "put_binding_name", - ud_put_fs = undef "put_fs" - } - -newWriteState :: (BinHandle -> Name -> IO ()) +-- | UserData required to deserialise symbols for interface files. +-- +-- See Note [Binary UserData] +data ReaderUserData = + ReaderUserData { + ud_reader_data :: Map TypeRep SomeBinaryReader + -- ^ A mapping from a type witness to the 'Reader' for the associated type. + -- This is a 'Map' because microbenchmarks indicated this is more efficient + -- than other representations for less than ten elements. + -- + -- Considered representations: + -- + -- * [(TypeRep, SomeBinaryReader)] + -- * bytehash (on hackage) + -- * Map TypeRep SomeBinaryReader + } + +mkWriterUserData :: [SomeBinaryWriter] -> WriterUserData +mkWriterUserData caches = noWriterUserData + { ud_writer_data = Map.fromList $ map (\cache@(SomeBinaryWriter typRep _) -> (typRep, cache)) caches + } + +mkReaderUserData :: [SomeBinaryReader] -> ReaderUserData +mkReaderUserData caches = noReaderUserData + { ud_reader_data = Map.fromList $ map (\cache@(SomeBinaryReader typRep _) -> (typRep, cache)) caches + } + +mkSomeBinaryWriter :: forall a . Typeable a => BinaryWriter a -> SomeBinaryWriter +mkSomeBinaryWriter cb = SomeBinaryWriter (typeRep (Proxy :: Proxy a)) cb + +mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReader +mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb + +data BinaryReader s = BinaryReader + { getEntry :: ReadBinHandle -> IO s + } deriving (Functor) + +data BinaryWriter s = BinaryWriter + { putEntry :: WriteBinHandle -> s -> IO () + } + +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter f = BinaryWriter + { putEntry = f + } + +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s +mkReader f = BinaryReader + { getEntry = f + } + +findUserDataReader :: forall a . Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a +findUserDataReader query bh = + case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of + Nothing -> panic $ "Failed to find BinaryReader for the key: " ++ show (typeRep query) + Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> + unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader + +findUserDataWriter :: forall a . Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a +findUserDataWriter query bh = + case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of + Nothing -> panic $ "Failed to find BinaryWriter for the key: " ++ show (typeRep query) + Just (SomeBinaryWriter _ (writer :: BinaryWriter x)) -> + unsafeCoerce @(BinaryWriter x) @(BinaryWriter a) writer + +noReaderUserData :: ReaderUserData +noReaderUserData = ReaderUserData + { ud_reader_data = Map.empty + } + +noWriterUserData :: WriterUserData +noWriterUserData = WriterUserData + { ud_writer_data = Map.empty + } + +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) + -> ReaderUserData +newReadState get_name get_fs = + mkReaderUserData + [ mkSomeBinaryReader $ mkReader get_name + , mkSomeBinaryReader $ mkReader @NonBindingName (coerce get_name) + , mkSomeBinaryReader $ mkReader get_fs + ] + +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize non-binding 'Name's - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) - -> UserData -newWriteState put_nonbinding_name put_binding_name put_fs - = UserData { ud_get_name = undef "get_name", - ud_get_fs = undef "get_fs", - ud_put_nonbinding_name = put_nonbinding_name, - ud_put_binding_name = put_binding_name, - ud_put_fs = put_fs - } - -noUserData :: UserData -noUserData = UserData - { ud_get_name = undef "get_name" - , ud_get_fs = undef "get_fs" - , ud_put_nonbinding_name = undef "put_nonbinding_name" - , ud_put_binding_name = undef "put_binding_name" - , ud_put_fs = undef "put_fs" + -> (WriteBinHandle -> FastString -> IO ()) + -> WriterUserData +newWriteState put_non_binding_name put_binding_name put_fs = + mkWriterUserData + [ mkSomeBinaryWriter $ mkWriter (\bh name -> put_non_binding_name bh (getNonBindingName name)) + , mkSomeBinaryWriter $ mkWriter put_binding_name + , mkSomeBinaryWriter $ mkWriter put_fs + ] + +-- ---------------------------------------------------------------------------- +-- Types for lookup and deduplication tables. +-- ---------------------------------------------------------------------------- + +data SomeReaderTable f = forall a . Typeable a => + SomeReaderTable (f (ReaderTable a)) + +data SomeWriterTable f = forall a . Typeable a => + SomeWriterTable (f (WriterTable, BinaryWriter a)) + +data ReaderTable a = ReaderTable + { getTable :: ReadBinHandle -> IO (SymbolTable a) + , mkReaderFromTable :: SymbolTable a -> BinaryReader a } -undef :: String -> a -undef s = panic ("Binary.UserData: no " ++ s) +data WriterTable = WriterTable + { putTable :: WriteBinHandle -> IO Int + } --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- -type Dictionary = Array Int FastString -- The dictionary - -- Should be 0-indexed +-- | A 'SymbolTable' of 'FastString's. +type Dictionary = SymbolTable FastString + +initFastStringReaderTable :: IO (ReaderTable FastString) +initFastStringReaderTable = do + return $ + ReaderTable + { getTable = getDictionary + , mkReaderFromTable = \tbl -> mkReader (getDictFastString tbl) + } + +initFastStringWriterTable :: IO (WriterTable, BinaryWriter FastString) +initFastStringWriterTable = do + dict_next_ref <- newFastMutInt 0 + dict_map_ref <- newIORef emptyUFM + let bin_dict = + FSTable + { fs_tab_next = dict_next_ref + , fs_tab_map = dict_map_ref + } + let put_dict bh = do + fs_count <- readFastMutInt dict_next_ref + dict_map <- readIORef dict_map_ref + putDictionary bh fs_count dict_map + pure fs_count -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () + return + ( WriterTable + { putTable = put_dict + } + , mkWriter $ putDictFastString bin_dict + ) + +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1156,34 +1356,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) - -initFSTable :: BinHandle -> IO (BinHandle, FSTable, IO Int) -initFSTable bh = do - dict_next_ref <- newFastMutInt 0 - dict_map_ref <- newIORef emptyUFM - let bin_dict = FSTable - { fs_tab_next = dict_next_ref - , fs_tab_map = dict_map_ref - } - let put_dict = do - fs_count <- readFastMutInt dict_next_ref - dict_map <- readIORef dict_map_ref - putDictionary bh fs_count dict_map - pure fs_count - - -- BinHandle with FastString writing support - let ud = getUserData bh - let ud_fs = ud { ud_put_fs = putDictFastString bin_dict } - let bh_fs = setUserData bh ud_fs - - return (bh_fs,bin_dict,put_dict) - -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1212,43 +1390,42 @@ data FSTable = FSTable { fs_tab_next :: !FastMutInt -- The next index to use -- The Symbol Table --------------------------------------------------------- --- On disk, the symbol table is an array of IfExtName, when --- reading it in we turn it into a SymbolTable. - -type SymbolTable = Array Int Name +-- | Symbols that are read from disk. +-- The 'SymbolTable' index starts on '0'. +type SymbolTable a = Array Int a --------------------------------------------------------- -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do @@ -1260,12 +1437,12 @@ instance Binary ByteString where instance Binary FastString where put_ bh f = - case getUserData bh of - UserData { ud_put_fs = put_fs } -> put_fs bh f + case findUserDataWriter (Proxy :: Proxy FastString) bh of + tbl -> putEntry tbl bh f get bh = - case getUserData bh of - UserData { ud_get_fs = get_fs } -> get_fs bh + case findUserDataReader (Proxy :: Proxy FastString) bh of + tbl -> getEntry tbl bh deriving instance Binary NonDetFastString deriving instance Binary LexicalFastString ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe +Subproject commit edf742131e272fc29c6d6eae549b0fe37eea11b9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3b37648179355fde9e450a55a56e09bc3a12944...54a9bfea91adfb6d72315e1b9570793b3ed9ebca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3b37648179355fde9e450a55a56e09bc3a12944...54a9bfea91adfb6d72315e1b9570793b3ed9ebca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 12:26:45 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 03 Apr 2024 08:26:45 -0400 Subject: [Git][ghc/ghc][wip/T24463] 54 commits: EPA: Extend StringLiteral range to include trailing commas Message-ID: <660d4b05e596a_4ce5c15b8f7883323@gitlab.mail> Simon Peyton Jones pushed to branch wip/T24463 at Glasgow Haskell Compiler / GHC Commits: 00d3ecf0 by Alan Zimmerman at 2024-03-29T12:19:10+00:00 EPA: Extend StringLiteral range to include trailing commas This goes slightly against the exact printing philosophy where trailing decorations should be in an annotation, but the practicalities of adding it to the WarningTxt environment, and the problems caused by deviating do not make a more principles approach worthwhile. - - - - - efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 6c2b98a6 by Simon Peyton Jones at 2024-04-03T10:23:55+01:00 Clone in CorePrep - - - - - 2a6a8249 by Simon Peyton Jones at 2024-04-03T10:23:55+01:00 Wibble - - - - - 19be874d by Simon Peyton Jones at 2024-04-03T10:23:55+01:00 Wibble - - - - - 15 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4c445c97492dfe9a5d12fb2b13d4291a4daa30c2...19be874ddb1318946d3332adc0264ac0f3074145 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4c445c97492dfe9a5d12fb2b13d4291a4daa30c2...19be874ddb1318946d3332adc0264ac0f3074145 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 12:43:36 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Wed, 03 Apr 2024 08:43:36 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` Message-ID: <660d4ef8c283b_4ce5c17fe79c921aa@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: 1e2705b0 by Fendor at 2024-04-03T14:43:14+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 12 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -77,7 +77,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -139,7 +139,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -150,7 +150,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -158,7 +158,7 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do let -- The order of these entries matters! @@ -197,14 +197,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -214,7 +214,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -238,7 +238,7 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int, Int, b) +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) putWithTables bh' put_payload = do let -- The order of these entries matters! @@ -384,7 +384,7 @@ initWriteNameTable = do ) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -393,7 +393,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -414,7 +414,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -438,7 +438,7 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: BinSymbolTable -> BinHandle -> Name -> IO () +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } @@ -464,7 +464,7 @@ putName BinSymbolTable{ -- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name - -> BinHandle -> IO Name + -> ReadBinHandle -> IO Name getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -112,9 +112,9 @@ writeHieFile hie_file_path hiefile = do put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next @@ -122,9 +122,9 @@ writeHieFile hie_file_path hiefile = do putSymbolTable bh symtab_next' symtab_map' -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -182,7 +182,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -191,7 +191,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -214,7 +214,7 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data @@ -233,21 +233,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -261,13 +261,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -277,12 +277,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable Name -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -335,7 +335,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -346,7 +346,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -1032,7 +1032,7 @@ addFingerprints hsc_env iface0 -- change if the fingerprint for anything it refers to (transitively) -- changes. mk_put_name :: OccEnv (OccName,Fingerprint) - -> BinHandle -> Name -> IO () + -> WriteBinHandle -> Name -> IO () mk_put_name local_env bh name | isWiredInName name = putNameLiterally bh name -- wired-in names don't have fingerprints ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -26,7 +26,7 @@ fingerprintBinMem bh = withBinBuffer bh f in fp `seq` return fp computeFingerprint :: (Binary a) - => (BinHandle -> Name -> IO ()) + => (WriteBinHandle -> Name -> IO ()) -> a -> IO Fingerprint computeFingerprint put_nonbinding_name a = do @@ -39,7 +39,7 @@ computeFingerprint put_nonbinding_name a = do -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -31,7 +31,7 @@ import System.FilePath (normalise) -- NB: The 'Module' parameter is the 'Module' recorded by the *interface* -- file, not the actual 'Module' according to our 'DynFlags'. fingerprintDynFlags :: HscEnv -> Module - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintDynFlags hsc_env this_mod nameio = @@ -81,7 +81,7 @@ fingerprintDynFlags hsc_env this_mod nameio = -- object files as they can. -- See Note [Ignoring some flag changes] fingerprintOptFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintOptFlags DynFlags{..} nameio = let @@ -99,7 +99,7 @@ fingerprintOptFlags DynFlags{..} nameio = -- file compiled for HPC when not actually using HPC. -- See Note [Ignoring some flag changes] fingerprintHpcFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintHpcFlags dflags at DynFlags{..} nameio = let ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -119,10 +119,10 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = case findUserDataWriter Proxy bh of tbl -> @@ -2445,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -89,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq -import Control.Monad +import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -322,7 +322,7 @@ putObject bh mod_name deps os = do -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -330,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -345,7 +345,7 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) @@ -353,7 +353,7 @@ getObjectBody bh0 mod_name = do block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -364,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -393,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -409,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -779,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -31,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -87,7 +89,6 @@ module GHC.Utils.Binary initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, - -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..), -- * Newtypes for types that have canonically more than one valid encoding @@ -173,70 +174,83 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noReaderUserData noWriterUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_reader :: ReaderUserData, -- sigh, need parameterized modules :-) - bh_writer :: WriterUserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: !WriterUserData, + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) + } + +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: !ReaderUserData, + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getReaderUserData :: BinHandle -> ReaderUserData -getReaderUserData bh = bh_reader bh +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh -getWriterUserData :: BinHandle -> WriterUserData -getWriterUserData bh = bh_writer bh +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setWriterUserData :: BinHandle -> WriterUserData -> BinHandle -setWriterUserData bh us = bh { bh_writer = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } -setReaderUserData :: BinHandle -> ReaderUserData -> BinHandle -setReaderUserData bh us = bh { bh_reader = us } +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } -addReaderToUserData :: SomeBinaryReader -> BinHandle -> BinHandle +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh - { bh_reader = (bh_reader bh) - { ud_reader_data = Map.insert typRep cache (ud_reader_data (bh_reader bh)) + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) } } -addWriterToUserData :: SomeBinaryWriter -> BinHandle -> BinHandle +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh - { bh_writer = (bh_writer bh) - { ud_writer_data = Map.insert typRep cache (ud_writer_data (bh_writer bh)) + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) } } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -255,23 +269,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -279,42 +293,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } + +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -323,20 +352,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -357,7 +389,7 @@ expandBin (BinMem _ _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -373,7 +405,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -394,8 +426,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -416,39 +448,37 @@ putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -456,7 +486,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -469,7 +499,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -481,7 +511,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -502,10 +532,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -528,15 +558,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -553,15 +583,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -577,15 +607,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -605,15 +635,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -1024,63 +1054,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1088,14 +1118,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1190,31 +1220,31 @@ mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReade mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb data BinaryReader s = BinaryReader - { getEntry :: BinHandle -> IO s + { getEntry :: ReadBinHandle -> IO s } deriving (Functor) data BinaryWriter s = BinaryWriter - { putEntry :: BinHandle -> s -> IO () + { putEntry :: WriteBinHandle -> s -> IO () } -mkWriter :: (BinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s mkWriter f = BinaryWriter { putEntry = f } -mkReader :: (BinHandle -> IO s) -> BinaryReader s +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s mkReader f = BinaryReader { getEntry = f } -findUserDataReader :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryReader a +findUserDataReader :: forall a . Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a findUserDataReader query bh = case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of Nothing -> panic $ "Failed to find BinaryReader for the key: " ++ show (typeRep query) Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader -findUserDataWriter :: forall a . Typeable a => Proxy a -> BinHandle -> BinaryWriter a +findUserDataWriter :: forall a . Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a findUserDataWriter query bh = case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of Nothing -> panic $ "Failed to find BinaryWriter for the key: " ++ show (typeRep query) @@ -1231,8 +1261,8 @@ noWriterUserData = WriterUserData { ud_writer_data = Map.empty } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) -> ReaderUserData newReadState get_name get_fs = mkReaderUserData @@ -1241,11 +1271,11 @@ newReadState get_name get_fs = , mkSomeBinaryReader $ mkReader get_fs ] -newWriteState :: (BinHandle -> Name -> IO ()) +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize non-binding 'Name's - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) + -> (WriteBinHandle -> FastString -> IO ()) -> WriterUserData newWriteState put_non_binding_name put_binding_name put_fs = mkWriterUserData @@ -1265,12 +1295,12 @@ data SomeWriterTable f = forall a . Typeable a => SomeWriterTable (f (WriterTable, BinaryWriter a)) data ReaderTable a = ReaderTable - { getTable :: BinHandle -> IO (SymbolTable a) + { getTable :: ReadBinHandle -> IO (SymbolTable a) , mkReaderFromTable :: SymbolTable a -> BinaryReader a } data WriterTable = WriterTable - { putTable :: BinHandle -> IO Int + { putTable :: WriteBinHandle -> IO Int } --------------------------------------------------------- @@ -1310,14 +1340,14 @@ initFastStringWriterTable = do , mkWriter $ putDictFastString bin_dict ) -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1326,12 +1356,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1368,34 +1398,34 @@ type SymbolTable a = Array Int a -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit c641b7349239c497cbd64a64cd21fd388f431b9f +Subproject commit edf742131e272fc29c6d6eae549b0fe37eea11b9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e2705b08f39e87ccb4396739f0c67ef999e8d88 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e2705b08f39e87ccb4396739f0c67ef999e8d88 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 13:32:25 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 Apr 2024 09:32:25 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 41 commits: Initial ./configure support for selecting I/O managers Message-ID: <660d5a697c0f5_4ce5c1efa5c81158c4@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - a11d1a57 by Ben Gamari at 2024-04-03T09:31:53-04:00 testsuite: Introduce template-haskell-exports test - - - - - 799caa34 by Luite Stegeman at 2024-04-03T09:32:00-04:00 Update correct counter in bumpTickyAllocd - - - - - a5f45a7f by Andrei Borzenkov at 2024-04-03T09:32:00-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 15 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/944ef9924c37b108174b8ed1006112dde4e7cc28...a5f45a7f00c7686d9f01075295370d205a6ad84c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/944ef9924c37b108174b8ed1006112dde4e7cc28...a5f45a7f00c7686d9f01075295370d205a6ad84c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 14:39:54 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Wed, 03 Apr 2024 10:39:54 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] 2 commits: Revert "Use TemplateHaskellQuotes in TH.Syntax to construct Names" Message-ID: <660d6a3a6e123_4ce5c26ff99412667e@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: 2a1c7a73 by Teo Camarasu at 2024-04-03T14:00:32+01:00 Revert "Use TemplateHaskellQuotes in TH.Syntax to construct Names" This reverts commit 983ce55815f2dd57f84ee86eee97febf7d80b470. - - - - - 85e4fe45 by Teo Camarasu at 2024-04-03T15:25:07+01:00 Make template-haskell a stage1 package Promoting template-haskell from a stage0 to a stage1 package means that we can much more easily refactor template-haskell. In order to accomplish this we now compile stage0 packages using the boot compiler's version of template-haskell. This means that there are now two versions of template-haskell in play: the boot compiler's version, and the in-tree version. When compiling the stage1 compiler, we have to pick a version of template-haskell to use. During bootstrapping we want to use the same version as the final compiler. This forces the in-tree version. We are only able to use the internal interpreter with stage2 onwards. Yet, we could still use the external interpreter. The external interpreter runs splices in another process. Queries and results are seralised. This reduces our compatibility requirements from ABI compatibility with the internal interpreter to mere serialisation compatibility. We may compile GHC against another library to what the external interpreter is compiled against so long as it has exactly the same serialisation of template-haskell types. This opens up the strategy pursued in this patch. We introduce two new packages: template-haskell-in-tree and ghc-boot-th-in-tree. These package are carbon copies of template-haskell and ghc-boot-th respectively. They only differ in their name. When compiling the stage1 compiler we use these to define the Template Haskell interface for the external interpreter. Note that at this point we also have the template-haskell and ghc-boot packages in our transitive dependency closure from the boot compiler, and some packages like containers have dependencies on these to define Lift instances. Then the external interpreter should be compiled against the regular template-haskell library from the source tree. As these two packages are identical, we can then run splices. GHC stage2 is compiled as normal as well against the template-haskell library from the source tree. Resolves #23536 - - - - - 13 changed files: - compiler/ghc.cabal.in - hadrian/src/Packages.hs - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - + libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal - + libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - + libraries/template-haskell-in-tree/template-haskell-in-tree.cabal - libraries/template-haskell/Language/Haskell/TH/Syntax.hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -82,6 +82,11 @@ Flag hadrian-stage0 Default: False Manual: True +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + Library Default-Language: GHC2021 Exposed: False @@ -115,7 +120,6 @@ Library containers >= 0.6.2.1 && < 0.8, array >= 0.1 && < 0.6, filepath >= 1 && < 1.6, - template-haskell == 2.22.*, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, @@ -125,6 +129,13 @@ Library ghc-heap == @ProjectVersionMunged@, ghci == @ProjectVersionMunged@ + if flag(bootstrap-th) + Build-Depends: + template-haskell-in-tree == 2.22.* + else + Build-Depends: + template-haskell == 2.22.* + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -4,12 +4,12 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, + runGhc, semaphoreCompat, stm, templateHaskell, templateHaskellInTree, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -37,11 +37,11 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim , ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl, osString - , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell, templateHaskellInTree , terminfo, text, time, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon @@ -54,11 +54,11 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, - osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, + osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, templateHaskellInTree, terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -87,6 +87,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcBootThInTree = lib "ghc-boot-th-in-tree" ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" @@ -123,6 +124,7 @@ runGhc = util "runghc" semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" +templateHaskellInTree = lib "template-haskell-in-tree" terminfo = lib "terminfo" text = lib "text" time = lib "time" ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -35,7 +35,10 @@ extra_dependencies = where th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") - dep (p1, m1) (p2, m2) s = do + dep (p1, m1) (p2, m2) s = + -- We use the boot compiler's `template-haskell` library when building stage0, + -- so we don't need to register dependencies. + if isStage0 s then pure [] else do let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set") ways <- interpretInContext context getLibraryWays mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -23,10 +23,12 @@ import Rules.Libffi import Settings import Target import Utilities +import Debug.Trace import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp)) import GHC.Toolchain.Program import GHC.Platform.ArchOS +import qualified System.Directory as IO -- | Track this file to rebuild generated files whenever it changes. trackGenerateHs :: Expr () @@ -119,6 +121,7 @@ generatePackageCode context@(Context stage pkg _ _) = do let dir = buildDir context generated f = (root -/- dir -/- "**/*.hs") ?== f && not ("//autogen/*" ?== f) go gen file = generate file context gen + generated ?> \file -> do let unpack = fromMaybe . error $ "No generator for " ++ file ++ "." (src, builder) <- unpack <$> findGenerator context file @@ -143,6 +146,22 @@ generatePackageCode context@(Context stage pkg _ _) = do when (pkg == ghcBoot) $ do root -/- "**" -/- dir -/- "GHC/Version.hs" %> go generateVersionHs root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs + when (pkg == ghcBootThInTree) $ do + let prefix = root -/- dir + prefix -/- "**/*.hs" %> \file -> do + cwd <- liftIO $ IO.getCurrentDirectory + createFileLink (cwd -/- "libraries/ghc-boot-th" -/- makeRelative prefix file) file + when (pkg == templateHaskellInTree) $ do + let prefix = root -/- dir + prefix -/- "**/*.hs" %> \file -> do + cwd <- liftIO $ IO.getCurrentDirectory + let rel = makeRelative prefix file + let rootCandidate = cwd -/- "libraries/template-haskell" -/- rel + let vendoredCandidate = cwd -/- "libraries/template-haskell" -/- "vendored-filepath" -/- rel + exists <- liftIO $ IO.doesFileExist rootCandidate + if exists + then createFileLink rootCandidate file + else createFileLink vendoredCandidate file when (pkg == compiler) $ do root -/- primopsTxt stage %> \file -> do @@ -325,6 +344,7 @@ templateRules = do templateRule "utils/runghc/runghc.cabal" $ projectVersion templateRule "libraries/ghc-boot/ghc-boot.cabal" $ projectVersion templateRule "libraries/ghc-boot-th/ghc-boot-th.cabal" $ projectVersion + templateRule "libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal" $ projectVersion templateRule "libraries/ghci/ghci.cabal" $ projectVersion templateRule "libraries/ghc-heap/ghc-heap.cabal" $ projectVersion templateRule "utils/ghc-pkg/ghc-pkg.cabal" $ projectVersion @@ -348,7 +368,6 @@ templateRules = do , interpolateVar "LlvmMaxVersion" $ replaceEq '.' ',' <$> setting LlvmMaxVersion ] - -- Generators -- | GHC wrapper scripts used for passing the path to the right package database ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,7 +158,7 @@ toolTargets = [ binary -- , ghc -- # depends on ghc library -- , runGhc -- # depends on ghc library , ghcBoot - , ghcBootTh + , ghcBootThInTree , ghcPlatform , ghcToolchain , ghcToolchainBin @@ -172,8 +172,8 @@ toolTargets = [ binary , mtl , parsec , time - , templateHaskell , text + , templateHaskellInTree , transformers , semaphoreCompat , unlit -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -93,7 +93,7 @@ stage0Packages = do , ghc , runGhc , ghcBoot - , ghcBootTh + , ghcBootThInTree , ghcPlatform , ghcHeap , ghcToolchain @@ -108,8 +108,8 @@ stage0Packages = do , parsec , semaphoreCompat , time - , templateHaskell , text + , templateHaskellInTree , transformers , unlit , hp2ps @@ -127,6 +127,10 @@ stage1Packages = do -- but not win32/unix because it depends on cross-compilation target | p == win32 = False | p == unix = False + -- we don't keep ghc-boot-in-tree and template-haskell-in-tree + -- as they are only needed for bootstrapping Template Haskell + | p == ghcBootThInTree = False + | p == templateHaskellInTree = False | otherwise = True libraries0 <- filter good_stage0_package <$> stage0Packages @@ -143,6 +147,7 @@ stage1Packages = do , deepseq , exceptions , ghc + , ghcBootTh , ghcBignum , ghcCompact , ghcExperimental @@ -156,6 +161,7 @@ stage1Packages = do , pretty , rts , semaphoreCompat + , templateHaskell , stm , unlit , xhtml ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -78,6 +78,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" + , stage0 `cabalFlag` "bootstrap-th" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" , flag UseLibzstd `cabalFlag` "with-libzstd" @@ -121,6 +122,10 @@ packageArgs = do , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ? input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ] + -------------------------------- ghcBoot ------------------------------ + , package ghcBoot ? + builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap-th") + --------------------------------- ghci --------------------------------- , package ghci ? mconcat [ @@ -151,9 +156,12 @@ packageArgs = do -- compiler comes with the same versions as the one we are building. -- builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir - , builder (Cabal Flags) ? ifM stage0 - (andM [cross, bootCross] `cabalFlag` "internal-interpreter") - (arg "internal-interpreter") + , builder (Cabal Flags) ? mconcat [ + ifM stage0 + (andM [cross, bootCross] `cabalFlag` "internal-interpreter") + (arg "internal-interpreter") + , stage0 `cabalFlag` "bootstrap-th" + ] ] ===================================== libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal ===================================== @@ -0,0 +1,39 @@ +-- WARNING: ghc-boot-th.cabal is automatically generated from +-- ghc-boot-th.cabal.in by ../../configure. Make sure you are editing +-- ghc-boot-th.cabal.in, not ghc-boot-th.cabal. + +name: ghc-boot-th-in-tree +version: 9.11 +license: BSD3 +license-file: LICENSE +category: GHC +maintainer: ghc-devs at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Shared functionality between GHC and the @template-haskell@ + library +description: This library contains various bits shared between the @ghc@ and + @template-haskell@ libraries. + . + This package exists to ensure that @template-haskell@ has a + minimal set of transitive dependencies, since it is intended to + be depended upon by user code. +cabal-version: >=1.10 +build-type: Simple +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/ghc-boot-th + +Library + default-language: Haskell2010 + other-extensions: DeriveGeneric + default-extensions: NoImplicitPrelude + + exposed-modules: + GHC.LanguageExtensions.Type + GHC.ForeignSrcLang.Type + GHC.Lexeme + + build-depends: base >= 4.7 && < 4.21 ===================================== libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal.in ===================================== @@ -0,0 +1,39 @@ +-- WARNING: ghc-boot-th.cabal is automatically generated from +-- ghc-boot-th.cabal.in by ../../configure. Make sure you are editing +-- ghc-boot-th.cabal.in, not ghc-boot-th.cabal. + +name: ghc-boot-th-in-tree +version: @ProjectVersionMunged@ +license: BSD3 +license-file: LICENSE +category: GHC +maintainer: ghc-devs at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Shared functionality between GHC and the @template-haskell@ + library +description: This library contains various bits shared between the @ghc@ and + @template-haskell@ libraries. + . + This package exists to ensure that @template-haskell@ has a + minimal set of transitive dependencies, since it is intended to + be depended upon by user code. +cabal-version: >=1.10 +build-type: Simple +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/ghc-boot-th + +Library + default-language: Haskell2010 + other-extensions: DeriveGeneric + default-extensions: NoImplicitPrelude + + exposed-modules: + GHC.LanguageExtensions.Type + GHC.ForeignSrcLang.Type + GHC.Lexeme + + build-depends: base >= 4.7 && < 4.21 ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -35,6 +35,11 @@ source-repository head location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/ghc-boot +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + Library default-language: Haskell2010 other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables @@ -81,7 +86,12 @@ Library filepath >= 1.3 && < 1.6, deepseq >= 1.4 && < 1.6, ghc-platform >= 0.1, - ghc-boot-th == @ProjectVersionMunged@ + if flag(bootstrap-th) + build-depends: + ghc-boot-th-in-tree == @ProjectVersionMunged@ + else + build-depends: + ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: unix >= 2.7 && < 2.9 ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -22,6 +22,11 @@ Flag internal-interpreter Default: False Manual: True +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + source-repository head type: git location: https://gitlab.haskell.org/ghc/ghc.git @@ -84,8 +89,14 @@ library filepath >= 1.4 && < 1.6, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, - template-haskell == 2.22.*, transformers >= 0.5 && < 0.7 + if flag(bootstrap-th) + Build-Depends: + template-haskell-in-tree == 2.22.* + else + Build-Depends: + template-haskell == 2.22.* + if !os(windows) Build-Depends: unix >= 2.7 && < 2.9 ===================================== libraries/template-haskell-in-tree/template-haskell-in-tree.cabal ===================================== @@ -0,0 +1,71 @@ +-- WARNING: template-haskell.cabal is automatically generated from template-haskell.cabal.in by +-- ../../configure. Make sure you are editing template-haskell.cabal.in, not +-- template-haskell.cabal. + +name: template-haskell-in-tree +version: 2.22.0.0 +-- NOTE: Don't forget to update ./changelog.md +license: BSD3 +license-file: LICENSE +category: Template Haskell +maintainer: libraries at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Support library for Template Haskell +build-type: Simple +Cabal-Version: >= 1.10 +description: + This package provides modules containing facilities for manipulating + Haskell source code using Template Haskell. + . + See for more + information. + +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/template-haskell-in-tree + +Library + default-language: Haskell2010 + other-extensions: + BangPatterns + CPP + DefaultSignatures + DeriveDataTypeable + DeriveGeneric + FlexibleInstances + RankNTypes + RoleAnnotations + ScopedTypeVariables + + exposed-modules: + Language.Haskell.TH + Language.Haskell.TH.Lib + Language.Haskell.TH.Ppr + Language.Haskell.TH.PprLib + Language.Haskell.TH.Quote + Language.Haskell.TH.Syntax + Language.Haskell.TH.LanguageExtensions + Language.Haskell.TH.CodeDo + Language.Haskell.TH.Lib.Internal + + other-modules: + Language.Haskell.TH.Lib.Map + + build-depends: + base >= 4.11 && < 4.21, + ghc-boot-th-in-tree == 9.11, + ghc-prim, + pretty == 1.1.* + + other-modules: + System.FilePath + System.FilePath.Posix + System.FilePath.Windows + hs-source-dirs: ./vendored-filepath . + default-extensions: + ImplicitPrelude + + ghc-options: -Wall ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -7,7 +7,6 @@ BangPatterns, RecordWildCards, ImplicitParams #-} {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} -{-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE StandaloneKindSignatures #-} ----------------------------------------------------------------------------- @@ -69,6 +68,7 @@ import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types +import GHC.Stack import Data.Array.Byte (ByteArray(..)) import GHC.Exts @@ -1083,7 +1083,8 @@ instance Lift (Fixed.Fixed a) where ex <- lift x return (ConE mkFixedName `AppE` ex) where - mkFixedName = 'Fixed.MkFixed + mkFixedName = + mkNameG DataName "base" "Data.Fixed" "MkFixed" instance Integral a => Lift (Ratio a) where liftTyped x = unsafeCodeCoerce (lift x) @@ -1152,8 +1153,19 @@ instance Lift ByteArray where ptr :: ForeignPtr Word8 ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb)) + +-- We can't use a TH quote in this module because we're in the template-haskell +-- package, so we conconct this quite defensive solution to make the correct name +-- which will work if the package name or module name changes in future. addrToByteArrayName :: Name -addrToByteArrayName = 'addrToByteArray +addrToByteArrayName = helper + where + helper :: HasCallStack => Name + helper = + case getCallStack ?callStack of + [] -> error "addrToByteArrayName: empty call stack" + (_, SrcLoc{..}) : _ -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray" + addrToByteArray :: Int -> Addr# -> ByteArray addrToByteArray (I# len) addr = runST $ ST $ @@ -1371,24 +1383,23 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g) trueName, falseName :: Name -trueName = 'True -falseName = 'False +trueName = mkNameG DataName "ghc-prim" "GHC.Types" "True" +falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False" nothingName, justName :: Name -nothingName = 'Nothing -justName = 'Just +nothingName = mkNameG DataName "ghc-internal" "GHC.Internal.Maybe" "Nothing" +justName = mkNameG DataName "ghc-internal" "GHC.Internal.Maybe" "Just" leftName, rightName :: Name -leftName = 'Left -rightName = 'Right +leftName = mkNameG DataName "ghc-internal" "GHC.Internal.Data.Either" "Left" +rightName = mkNameG DataName "ghc-internal" "GHC.Internal.Data.Either" "Right" nonemptyName :: Name -nonemptyName = '(:|) +nonemptyName = mkNameG DataName "ghc-internal" "GHC.Internal.Base" ":|" oneName, manyName :: Name -oneName = 'One -manyName = 'Many - +oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" +manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" ----------------------------------------------------- -- -- Generic Lift implementations View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9290c3e65208709854b1419e649228d37816194...85e4fe4520970b390b6cd6eacaf0e59d2d63f2b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9290c3e65208709854b1419e649228d37816194...85e4fe4520970b390b6cd6eacaf0e59d2d63f2b7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 14:57:21 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Wed, 03 Apr 2024 10:57:21 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] Make template-haskell a stage1 package Message-ID: <660d6e50e8b14_231e18855c045868@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: d3f22b9f by Teo Camarasu at 2024-04-03T15:55:45+01:00 Make template-haskell a stage1 package Promoting template-haskell from a stage0 to a stage1 package means that we can much more easily refactor template-haskell. In order to accomplish this we now compile stage0 packages using the boot compiler's version of template-haskell. This means that there are now two versions of template-haskell in play: the boot compiler's version, and the in-tree version. When compiling the stage1 compiler, we have to pick a version of template-haskell to use. During bootstrapping we want to use the same version as the final compiler. This forces the in-tree version. We are only able to use the internal interpreter with stage2 onwards. Yet, we could still use the external interpreter. The external interpreter runs splices in another process. Queries and results are seralised. This reduces our compatibility requirements from ABI compatibility with the internal interpreter to mere serialisation compatibility. We may compile GHC against another library to what the external interpreter is compiled against so long as it has exactly the same serialisation of template-haskell types. This opens up the strategy pursued in this patch. We introduce two new packages: template-haskell-in-tree and ghc-boot-th-in-tree. These package are carbon copies of template-haskell and ghc-boot-th respectively. They only differ in their name. When compiling the stage1 compiler we use these to define the Template Haskell interface for the external interpreter. Note that at this point we also have the template-haskell and ghc-boot packages in our transitive dependency closure from the boot compiler, and some packages like containers have dependencies on these to define Lift instances. Then the external interpreter should be compiled against the regular template-haskell library from the source tree. As these two packages are identical, we can then run splices. GHC stage2 is compiled as normal as well against the template-haskell library from the source tree. Resolves #23536 - - - - - 12 changed files: - compiler/ghc.cabal.in - hadrian/src/Packages.hs - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - + libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal - + libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - + libraries/template-haskell-in-tree/template-haskell-in-tree.cabal Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -82,6 +82,11 @@ Flag hadrian-stage0 Default: False Manual: True +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + Library Default-Language: GHC2021 Exposed: False @@ -115,7 +120,6 @@ Library containers >= 0.6.2.1 && < 0.8, array >= 0.1 && < 0.6, filepath >= 1 && < 1.6, - template-haskell == 2.22.*, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, @@ -125,6 +129,13 @@ Library ghc-heap == @ProjectVersionMunged@, ghci == @ProjectVersionMunged@ + if flag(bootstrap-th) + Build-Depends: + template-haskell-in-tree == 2.22.* + else + Build-Depends: + template-haskell == 2.22.* + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -4,12 +4,12 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, + runGhc, semaphoreCompat, stm, templateHaskell, templateHaskellInTree, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -37,11 +37,11 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim , ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl, osString - , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell, templateHaskellInTree , terminfo, text, time, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon @@ -54,11 +54,11 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, - osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, + osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, templateHaskellInTree, terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -87,6 +87,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcBootThInTree = lib "ghc-boot-th-in-tree" ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" @@ -123,6 +124,7 @@ runGhc = util "runghc" semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" +templateHaskellInTree = lib "template-haskell-in-tree" terminfo = lib "terminfo" text = lib "text" time = lib "time" ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -35,7 +35,10 @@ extra_dependencies = where th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") - dep (p1, m1) (p2, m2) s = do + dep (p1, m1) (p2, m2) s = + -- We use the boot compiler's `template-haskell` library when building stage0, + -- so we don't need to register dependencies. + if isStage0 s then pure [] else do let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set") ways <- interpretInContext context getLibraryWays mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -27,6 +27,7 @@ import Utilities import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp)) import GHC.Toolchain.Program import GHC.Platform.ArchOS +import qualified System.Directory as IO -- | Track this file to rebuild generated files whenever it changes. trackGenerateHs :: Expr () @@ -119,6 +120,7 @@ generatePackageCode context@(Context stage pkg _ _) = do let dir = buildDir context generated f = (root -/- dir -/- "**/*.hs") ?== f && not ("//autogen/*" ?== f) go gen file = generate file context gen + generated ?> \file -> do let unpack = fromMaybe . error $ "No generator for " ++ file ++ "." (src, builder) <- unpack <$> findGenerator context file @@ -143,6 +145,22 @@ generatePackageCode context@(Context stage pkg _ _) = do when (pkg == ghcBoot) $ do root -/- "**" -/- dir -/- "GHC/Version.hs" %> go generateVersionHs root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs + when (pkg == ghcBootThInTree) $ do + let prefix = root -/- dir + prefix -/- "**/*.hs" %> \file -> do + cwd <- liftIO $ IO.getCurrentDirectory + createFileLink (cwd -/- "libraries/ghc-boot-th" -/- makeRelative prefix file) file + when (pkg == templateHaskellInTree) $ do + let prefix = root -/- dir + prefix -/- "**/*.hs" %> \file -> do + cwd <- liftIO $ IO.getCurrentDirectory + let rel = makeRelative prefix file + let rootCandidate = cwd -/- "libraries/template-haskell" -/- rel + let vendoredCandidate = cwd -/- "libraries/template-haskell" -/- "vendored-filepath" -/- rel + exists <- liftIO $ IO.doesFileExist rootCandidate + if exists + then createFileLink rootCandidate file + else createFileLink vendoredCandidate file when (pkg == compiler) $ do root -/- primopsTxt stage %> \file -> do @@ -325,6 +343,7 @@ templateRules = do templateRule "utils/runghc/runghc.cabal" $ projectVersion templateRule "libraries/ghc-boot/ghc-boot.cabal" $ projectVersion templateRule "libraries/ghc-boot-th/ghc-boot-th.cabal" $ projectVersion + templateRule "libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal" $ projectVersion templateRule "libraries/ghci/ghci.cabal" $ projectVersion templateRule "libraries/ghc-heap/ghc-heap.cabal" $ projectVersion templateRule "utils/ghc-pkg/ghc-pkg.cabal" $ projectVersion @@ -348,7 +367,6 @@ templateRules = do , interpolateVar "LlvmMaxVersion" $ replaceEq '.' ',' <$> setting LlvmMaxVersion ] - -- Generators -- | GHC wrapper scripts used for passing the path to the right package database ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,7 +158,7 @@ toolTargets = [ binary -- , ghc -- # depends on ghc library -- , runGhc -- # depends on ghc library , ghcBoot - , ghcBootTh + , ghcBootThInTree , ghcPlatform , ghcToolchain , ghcToolchainBin @@ -172,8 +172,8 @@ toolTargets = [ binary , mtl , parsec , time - , templateHaskell , text + , templateHaskellInTree , transformers , semaphoreCompat , unlit -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -93,7 +93,7 @@ stage0Packages = do , ghc , runGhc , ghcBoot - , ghcBootTh + , ghcBootThInTree , ghcPlatform , ghcHeap , ghcToolchain @@ -108,8 +108,8 @@ stage0Packages = do , parsec , semaphoreCompat , time - , templateHaskell , text + , templateHaskellInTree , transformers , unlit , hp2ps @@ -127,6 +127,10 @@ stage1Packages = do -- but not win32/unix because it depends on cross-compilation target | p == win32 = False | p == unix = False + -- we don't keep ghc-boot-in-tree and template-haskell-in-tree + -- as they are only needed for bootstrapping Template Haskell + | p == ghcBootThInTree = False + | p == templateHaskellInTree = False | otherwise = True libraries0 <- filter good_stage0_package <$> stage0Packages @@ -143,6 +147,7 @@ stage1Packages = do , deepseq , exceptions , ghc + , ghcBootTh , ghcBignum , ghcCompact , ghcExperimental @@ -156,6 +161,7 @@ stage1Packages = do , pretty , rts , semaphoreCompat + , templateHaskell , stm , unlit , xhtml ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -78,6 +78,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" + , stage0 `cabalFlag` "bootstrap-th" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" , flag UseLibzstd `cabalFlag` "with-libzstd" @@ -121,6 +122,10 @@ packageArgs = do , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ? input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ] + -------------------------------- ghcBoot ------------------------------ + , package ghcBoot ? + builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap-th") + --------------------------------- ghci --------------------------------- , package ghci ? mconcat [ @@ -151,9 +156,12 @@ packageArgs = do -- compiler comes with the same versions as the one we are building. -- builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir - , builder (Cabal Flags) ? ifM stage0 - (andM [cross, bootCross] `cabalFlag` "internal-interpreter") - (arg "internal-interpreter") + , builder (Cabal Flags) ? mconcat [ + ifM stage0 + (andM [cross, bootCross] `cabalFlag` "internal-interpreter") + (arg "internal-interpreter") + , stage0 `cabalFlag` "bootstrap-th" + ] ] ===================================== libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal ===================================== @@ -0,0 +1,39 @@ +-- WARNING: ghc-boot-th.cabal is automatically generated from +-- ghc-boot-th.cabal.in by ../../configure. Make sure you are editing +-- ghc-boot-th.cabal.in, not ghc-boot-th.cabal. + +name: ghc-boot-th-in-tree +version: 9.11 +license: BSD3 +license-file: LICENSE +category: GHC +maintainer: ghc-devs at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Shared functionality between GHC and the @template-haskell@ + library +description: This library contains various bits shared between the @ghc@ and + @template-haskell@ libraries. + . + This package exists to ensure that @template-haskell@ has a + minimal set of transitive dependencies, since it is intended to + be depended upon by user code. +cabal-version: >=1.10 +build-type: Simple +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/ghc-boot-th + +Library + default-language: Haskell2010 + other-extensions: DeriveGeneric + default-extensions: NoImplicitPrelude + + exposed-modules: + GHC.LanguageExtensions.Type + GHC.ForeignSrcLang.Type + GHC.Lexeme + + build-depends: base >= 4.7 && < 4.21 ===================================== libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal.in ===================================== @@ -0,0 +1,39 @@ +-- WARNING: ghc-boot-th-in-tree.cabal is automatically generated from +-- ghc-boot-th.cabal-in-tree.in by ../../configure. Make sure you are editing +-- ghc-boot-th.cabal-in-tree.in, not ghc-boot-th-in-tree.cabal. + +name: ghc-boot-th-in-tree +version: @ProjectVersionMunged@ +license: BSD3 +license-file: LICENSE +category: GHC +maintainer: ghc-devs at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Shared functionality between GHC and the @template-haskell@ + library +description: This library contains various bits shared between the @ghc@ and + @template-haskell@ libraries. + . + This package exists to ensure that @template-haskell@ has a + minimal set of transitive dependencies, since it is intended to + be depended upon by user code. +cabal-version: >=1.10 +build-type: Simple +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/ghc-boot-th-in-tree + +Library + default-language: Haskell2010 + other-extensions: DeriveGeneric + default-extensions: NoImplicitPrelude + + exposed-modules: + GHC.LanguageExtensions.Type + GHC.ForeignSrcLang.Type + GHC.Lexeme + + build-depends: base >= 4.7 && < 4.21 ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -35,6 +35,11 @@ source-repository head location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/ghc-boot +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + Library default-language: Haskell2010 other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables @@ -81,7 +86,12 @@ Library filepath >= 1.3 && < 1.6, deepseq >= 1.4 && < 1.6, ghc-platform >= 0.1, - ghc-boot-th == @ProjectVersionMunged@ + if flag(bootstrap-th) + build-depends: + ghc-boot-th-in-tree == @ProjectVersionMunged@ + else + build-depends: + ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: unix >= 2.7 && < 2.9 ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -22,6 +22,11 @@ Flag internal-interpreter Default: False Manual: True +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + source-repository head type: git location: https://gitlab.haskell.org/ghc/ghc.git @@ -84,8 +89,14 @@ library filepath >= 1.4 && < 1.6, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, - template-haskell == 2.22.*, transformers >= 0.5 && < 0.7 + if flag(bootstrap-th) + Build-Depends: + template-haskell-in-tree == 2.22.* + else + Build-Depends: + template-haskell == 2.22.* + if !os(windows) Build-Depends: unix >= 2.7 && < 2.9 ===================================== libraries/template-haskell-in-tree/template-haskell-in-tree.cabal ===================================== @@ -0,0 +1,71 @@ +-- WARNING: template-haskell.cabal is automatically generated from template-haskell.cabal.in by +-- ../../configure. Make sure you are editing template-haskell.cabal.in, not +-- template-haskell.cabal. + +name: template-haskell-in-tree +version: 2.22.0.0 +-- NOTE: Don't forget to update ./changelog.md +license: BSD3 +license-file: LICENSE +category: Template Haskell +maintainer: libraries at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Support library for Template Haskell +build-type: Simple +Cabal-Version: >= 1.10 +description: + This package provides modules containing facilities for manipulating + Haskell source code using Template Haskell. + . + See for more + information. + +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/template-haskell-in-tree + +Library + default-language: Haskell2010 + other-extensions: + BangPatterns + CPP + DefaultSignatures + DeriveDataTypeable + DeriveGeneric + FlexibleInstances + RankNTypes + RoleAnnotations + ScopedTypeVariables + + exposed-modules: + Language.Haskell.TH + Language.Haskell.TH.Lib + Language.Haskell.TH.Ppr + Language.Haskell.TH.PprLib + Language.Haskell.TH.Quote + Language.Haskell.TH.Syntax + Language.Haskell.TH.LanguageExtensions + Language.Haskell.TH.CodeDo + Language.Haskell.TH.Lib.Internal + + other-modules: + Language.Haskell.TH.Lib.Map + + build-depends: + base >= 4.11 && < 4.21, + ghc-boot-th-in-tree == 9.11, + ghc-prim, + pretty == 1.1.* + + other-modules: + System.FilePath + System.FilePath.Posix + System.FilePath.Windows + hs-source-dirs: ./vendored-filepath . + default-extensions: + ImplicitPrelude + + ghc-options: -Wall View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3f22b9f04663d4db5b9b73ffa5ad09397ba6185 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3f22b9f04663d4db5b9b73ffa5ad09397ba6185 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 14:57:31 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 03 Apr 2024 10:57:31 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 2 commits: rts: Make addDLL a wrapper around loadNativeObj Message-ID: <660d6e5b65e0_231e1885b74459ee@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 19a7bf09 by Rodrigo Mesquita at 2024-04-03T15:55:00+01:00 rts: Make addDLL a wrapper around loadNativeObj Rewrite the implementation of `addDLL` as a wrapper around the more principled `loadNativeObj` rts linker function. The latter should be preferred while the former is preserved for backwards compatibility. `loadNativeObj` was previously only available on ELF platforms, so this commit further refactors the rts linker to transform loadNativeObj_ELF into loadNativeObj_POSIX, which is available in ELF and MachO platforms. The refactor made it possible to remove the `dl_mutex` mutex in favour of always using `linker_mutex` (rather than a combination of both). Lastly, we implement `loadNativeObj` for Windows too. - - - - - f7fae3a0 by Rodrigo Mesquita at 2024-04-03T15:55:00+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 18 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - libraries/ghci/GHCi/ObjLink.hs - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/include/rts/Linker.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/linker/PEi386.c - rts/linker/PEi386.h - rts/rts.cabal - testsuite/tests/ghci/linking/dyn/T3372.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== libraries/ghci/GHCi/ObjLink.hs ===================================== @@ -74,7 +74,7 @@ lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a)) lookupSymbolInDLL dll str_in = do let str = prefixUnderscore str_in withCAString str $ \c_str -> do - addr <- c_lookupSymbolInDLL dll c_str + addr <- c_lookupSymbolInNativeObj dll c_str if addr == nullPtr then return Nothing else return (Just addr) @@ -112,7 +112,7 @@ loadDLL str0 = do -- (maybe_handle, maybe_errmsg) <- withFilePath (normalise str) $ \dll -> alloca $ \errmsg_ptr -> (,) - <$> c_addDLL dll errmsg_ptr + <$> c_loadNativeObj dll errmsg_ptr <*> peek errmsg_ptr if maybe_handle == nullPtr @@ -176,8 +176,8 @@ resolveObjs = do -- Foreign declarations to RTS entry points which does the real work; -- --------------------------------------------------------------------------- -foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> Ptr CString -> IO (Ptr LoadedDLL) -foreign import ccall unsafe "lookupSymbolInDLL" c_lookupSymbolInDLL :: Ptr LoadedDLL -> CString -> IO (Ptr a) +foreign import ccall unsafe "loadNativeObj" c_loadNativeObj :: CFilePath -> Ptr CString -> IO (Ptr LoadedDLL) +foreign import ccall unsafe "lookupSymbolInNativeObj" c_lookupSymbolInNativeObj :: Ptr LoadedDLL -> CString -> IO (Ptr a) foreign import ccall unsafe "initLinker_" c_initLinker_ :: CInt -> IO () foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInNativeObj) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -417,11 +421,8 @@ static int linker_init_done = 0 ; #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) static void *dl_prog_handle; -static regex_t re_invalid; -static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif +regex_t re_invalid; +regex_t re_realso; #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -556,87 +551,6 @@ exitLinker( void ) { # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -/* Suppose in ghci we load a temporary SO for a module containing - f = 1 - and then modify the module, recompile, and load another temporary - SO with - f = 2 - Then as we don't unload the first SO, dlsym will find the - f = 1 - symbol whereas we want the - f = 2 - symbol. We therefore need to keep our own SO handle list, and - try SOs in the right order. */ - -typedef - struct _OpenedSO { - struct _OpenedSO* next; - void *handle; - } - OpenedSO; - -/* A list thereof. */ -static OpenedSO* openedSOs = NULL; - -static void * -internal_dlopen(const char *dll_name, const char **errmsg_ptr) -{ - OpenedSO* o_so; - void *hdl; - - // omitted: RTLD_NOW - // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html - IF_DEBUG(linker, - debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name)); - - //-------------- Begin critical section ------------------ - // This critical section is necessary because dlerror() is not - // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008) - // Also, the error message returned must be copied to preserve it - // (see POSIX also) - - ACQUIRE_LOCK(&dl_mutex); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - if (hdl == NULL) { - /* dlopen failed; return a ptr to the error msg. */ - char *errmsg = dlerror(); - if (errmsg == NULL) errmsg = "addDLL: unknown error"; - char *errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL"); - strcpy(errmsg_copy, errmsg); - *errmsg_ptr = errmsg_copy; - } else { - o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL"); - o_so->handle = hdl; - o_so->next = openedSOs; - openedSOs = o_so; - } - - RELEASE_LOCK(&dl_mutex); - //--------------- End critical section ------------------- - - return hdl; -} - /* Note [RTLD_LOCAL] ~~~~~~~~~~~~~~~~~ @@ -657,11 +571,10 @@ internal_dlopen(const char *dll_name, const char **errmsg_ptr) static void * internal_dlsym(const char *symbol) { - OpenedSO* o_so; void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -669,20 +582,19 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } - for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) { - v = dlsym(o_so->handle, symbol); - if (dlerror() == NULL) { + for (ObjectCode *nc = loaded_objects; nc; nc = nc->next_loaded_object) { + if (nc->type == DYNAMIC_OBJECT) { + v = dlsym(nc->dlopen_handle, symbol); + if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; + } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -722,98 +634,37 @@ internal_dlsym(const char *symbol) { // we failed to find the symbol return NULL; } +# endif -void *lookupSymbolInDLL(void *handle, const char *symbol_name) +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { + ACQUIRE_LOCK(&linker_mutex); + #if defined(OBJFORMAT_MACHO) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif - - ACQUIRE_LOCK(&dl_mutex); // dlsym alters dlerror +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); - RELEASE_LOCK(&dl_mutex); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif + + RELEASE_LOCK(&linker_mutex); return result; } -# endif -void *addDLL(pathchar* dll_name, const char **errmsg_ptr) +const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - /* ------------------- ELF DLL loader ------------------- */ - -#define NMATCH 5 - regmatch_t match[NMATCH]; - void *handle; - const char *errmsg; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; - - IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name)); - handle = internal_dlopen(dll_name, &errmsg); - - if (handle != NULL) { - return handle; - } - - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg)); - result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - *errmsg_ptr = errmsg; // return original error if open fails - return NULL; - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)errmsg); // Free old message before creating new one - handle = internal_dlopen(line+match[2].rm_so, errmsg_ptr); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); + char *errmsg; + if (loadNativeObj(dll_name, &errmsg)) { + return NULL; + } else { + ASSERT(errmsg != NULL); + return errmsg; } - return handle; - -# elif defined(OBJFORMAT_PEi386) - // FIXME - return addDLL_PEi386(dll_name, NULL); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1240,10 +1091,10 @@ void freeObjectCode (ObjectCode *oc) } if (oc->type == DYNAMIC_OBJECT) { -#if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); +#if defined(OBJFORMAT_ELF) || defined(darwin_HOST_OS) + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1908,12 +1759,20 @@ HsInt purgeObj (pathchar *path) return r; } +ObjectCode *lookupObjectByPath(pathchar *path) { + for (ObjectCode *o = objects; o; o = o->next) { + if (0 == pathcmp(o->fileName, path)) { + return o; + } + } + return NULL; +} + OStatus getObjectLoadStatus_ (pathchar *path) { - for (ObjectCode *o = objects; o; o = o->next) { - if (0 == pathcmp(o->fileName, path)) { - return o->status; - } + ObjectCode *oc = lookupObjectByPath(path); + if (oc) { + return oc->status; } return OBJECT_NOT_LOADED; } @@ -2000,25 +1859,33 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) void * loadNativeObj (pathchar *path, char **errmsg) { + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); - RELEASE_LOCK(&linker_mutex); - return r; -} + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); #else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); barf("loadNativeObj: not implemented on this platform"); -} #endif -HsInt unloadNativeObj (void *handle) +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); + } +#endif + + RELEASE_LOCK(&linker_mutex); + return r; +} + +static HsInt unloadNativeObj_(void *handle) { bool unloadedAnyObj = false; @@ -2051,11 +1918,18 @@ HsInt unloadNativeObj (void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } +HsInt unloadNativeObj(void *handle) { + ACQUIRE_LOCK(&linker_mutex); + HsInt r = unloadNativeObj_(handle); + RELEASE_LOCK(&linker_mutex); + return r; +} + /* ----------------------------------------------------------------------------- * Segment management */ ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ @@ -515,9 +511,9 @@ HsInt loadArchive_ (pathchar *path); #define USE_CONTIGUOUS_MMAP 0 #endif - HsInt isAlreadyLoaded( pathchar *path ); OStatus getObjectLoadStatus_ (pathchar *path); +ObjectCode *lookupObjectByPath(pathchar *path); HsInt loadOc( ObjectCode* oc ); ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize, bool mapped, pathchar *archiveMemberName, ===================================== rts/RtsSymbols.c ===================================== @@ -509,6 +509,7 @@ extern char **environ; SymI_HasDataProto(stg_block_putmvar) \ MAIN_CAP_SYM \ SymI_HasProto(addDLL) \ + SymI_HasProto(loadNativeObj) \ SymI_HasProto(addLibrarySearchPath) \ SymI_HasProto(removeLibrarySearchPath) \ SymI_HasProto(findSystemLibrary) \ @@ -619,7 +620,7 @@ extern char **environ; SymI_HasProto(purgeObj) \ SymI_HasProto(insertSymbol) \ SymI_HasProto(lookupSymbol) \ - SymI_HasProto(lookupSymbolInDLL) \ + SymI_HasProto(lookupSymbolInNativeObj) \ SymI_HasDataProto(stg_makeStablePtrzh) \ SymI_HasDataProto(stg_mkApUpd0zh) \ SymI_HasDataProto(stg_labelThreadzh) \ ===================================== rts/include/rts/Linker.h ===================================== @@ -90,10 +90,10 @@ void *loadNativeObj( pathchar *path, char **errmsg ); Takes the handle returned from loadNativeObj() as an argument. */ HsInt unloadNativeObj( void *handle ); -/* load a dynamic library */ -void *addDLL(pathchar* dll_name, const char **errmsg); +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name); -void *lookupSymbolInDLL(void *handle, const char *symbol_name); +/* load a dynamic library */ +const char *addDLL(pathchar* dll_name); /* add a path to the library search path */ HsPtr addLibrarySearchPath(pathchar* dll_path); ===================================== rts/linker/Elf.c ===================================== @@ -27,11 +27,15 @@ #include "sm/OSMem.h" #include "linker/util.h" #include "linker/elf_util.h" +#include "linker/LoadNativeObjPosix.h" +#include #include #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,159 +2073,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - /* Loading the same object multiple times will lead to chaos - * as we will have two ObjectCodes but one underlying dlopen - * handle. Fail if this happens. - */ - if (getObjectLoadStatus_(path) != OBJECT_NOT_LOADED) { - copyErrmsg(errmsg, "loadNativeObj_ELF: Already loaded"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); - nc->dlopen_handle = hdl; - foreignExportsFinishedLoadingObject(); - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2271,4 +2122,71 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +extern regex_t re_invalid; +extern regex_t re_realso; + +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex); + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,214 @@ +#include "LinkerInternals.h" +#include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + +#endif /* elf + macho */ ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/linker/PEi386.c ===================================== @@ -1017,7 +1017,10 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f stgFree(dllName); IF_DEBUG(linker, debugBelch("loadArchive: read symbol %s from lib `%" PATH_FMT "'\n", symbol, dll)); - const char* result = addDLL(dll); + // We must call `addDLL_PEi386` directly rather than `addDLL` because `addDLL` + // is now a wrapper around `loadNativeObj` which acquires a lock which we + // already have here. + const char* result = addDLL_PEi386(dll, NULL); stgFree(image); @@ -1141,47 +1144,57 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; + SymbolAddr* res; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + if ((res = lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent))) + return res; + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name STG_UNUSED, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %ls\n", lbl+STRIP_LEADING_UNDERSCORE,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c ===================================== testsuite/tests/ghci/linking/dyn/T3372.hs ===================================== @@ -1,3 +1,6 @@ +-- Note: This test exercises running concurrent GHCi sessions, but +-- although this test is expected to pass, running concurrent GHCi +-- sessions is currently broken in other ways; see #24345. {-# LANGUAGE MagicHash #-} module Main where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e59449effd9630750533bf536a975eff1b7b6e8...f7fae3a08236c0243cdb691ebfdfe53b95606148 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e59449effd9630750533bf536a975eff1b7b6e8...f7fae3a08236c0243cdb691ebfdfe53b95606148 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 14:57:39 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 03 Apr 2024 10:57:39 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 3 commits: linker: Avoid linear search when looking up Haskell symbols via dlsym Message-ID: <660d6e634dfb2_231e18af488461e7@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 4e470201 by Alexis King at 2024-04-03T15:55:42+01:00 linker: Avoid linear search when looking up Haskell symbols via dlsym See the primary Note [Looking up symbols in the relevant objects] for a more in-depth explanation. When dynamically loading a Haskell symbol (typical when running a splice or GHCi expression), before this commit we would search for the symbol in all dynamic libraries that were loaded. However, this could be very inefficient when too many packages are loaded (which can happen if there are many package dependencies) because the time to lookup the would be linear in the number of packages loaded. This commit drastically improves symbol loading performance by introducing a mapping from units to the handles of corresponding loaded dlls. These handles are returned by dlopen when we load a dll, and can then be used to look up in a specific dynamic library. Looking up a given Name is now much more precise because we can get lookup its unit in the mapping and lookup the symbol solely in the handles of the dynamic libraries loaded for that unit. In one measurement, the wait time before the expression was executed went from +-38 seconds down to +-2s. This commit also includes Note [Symbols may not be found in pkgs_loaded], explaining the fallback to the old behaviour in case no dll can be found in the unit mapping for a given Name. Fixes #23415 Co-authored-by: Rodrigo Mesquita (@alt-romes) - - - - - 2a219c62 by Rodrigo Mesquita at 2024-04-03T15:55:42+01:00 rts: Make addDLL a wrapper around loadNativeObj Rewrite the implementation of `addDLL` as a wrapper around the more principled `loadNativeObj` rts linker function. The latter should be preferred while the former is preserved for backwards compatibility. `loadNativeObj` was previously only available on ELF platforms, so this commit further refactors the rts linker to transform loadNativeObj_ELF into loadNativeObj_POSIX, which is available in ELF and MachO platforms. The refactor made it possible to remove the `dl_mutex` mutex in favour of always using `linker_mutex` (rather than a combination of both). Lastly, we implement `loadNativeObj` for Windows too. - - - - - 39e5cb6c by Rodrigo Mesquita at 2024-04-03T15:55:42+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 26 changed files: - compiler/GHC.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/MacOS.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/ObjLink.hs - libraries/ghci/GHCi/Run.hs - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/include/rts/Linker.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/linker/PEi386.c - rts/linker/PEi386.h - rts/rts.cabal - testsuite/tests/ghci/linking/dyn/T3372.hs - testsuite/tests/rts/linker/T2615.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -24,6 +24,7 @@ import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHC.Builtin.PrimOps +import GHC.Builtin.PrimOps.Ids import GHC.Builtin.Names import GHC.Unit.Types @@ -38,6 +39,8 @@ import GHC.Utils.Outputable import GHC.Types.Name import GHC.Types.Name.Env +import qualified GHC.Types.Id as Id +import GHC.Types.Unique.DFM import Language.Haskell.Syntax.Module.Name @@ -52,31 +55,32 @@ import GHC.Exts linkBCO :: Interp + -> PkgsLoaded -> LinkerEnv -> NameEnv Int -> UnlinkedBCO -> IO ResolvedBCO -linkBCO interp le bco_ix +linkBCO interp pkgs_loaded le bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - lits <- mapM (fmap fromIntegral . lookupLiteral interp le) (ssElts lits0) - ptrs <- mapM (resolvePtr interp le bco_ix) (ssElts ptrs0) + lits <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (ssElts lits0) + ptrs <- mapM (resolvePtr interp pkgs_loaded le bco_ix) (ssElts ptrs0) return (ResolvedBCO isLittleEndian arity insns bitmap (listArray (0, fromIntegral (sizeSS lits0)-1) lits) (addListToSS emptySS ptrs)) -lookupLiteral :: Interp -> LinkerEnv -> BCONPtr -> IO Word -lookupLiteral interp le ptr = case ptr of +lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word +lookupLiteral interp pkgs_loaded le ptr = case ptr of BCONPtrWord lit -> return lit BCONPtrLbl sym -> do Ptr a# <- lookupStaticPtr interp sym return (W# (int2Word# (addr2Int# a#))) BCONPtrItbl nm -> do - Ptr a# <- lookupIE interp (itbl_env le) nm + Ptr a# <- lookupIE interp pkgs_loaded (itbl_env le) nm return (W# (int2Word# (addr2Int# a#))) BCONPtrAddr nm -> do - Ptr a# <- lookupAddr interp (addr_env le) nm + Ptr a# <- lookupAddr interp pkgs_loaded (addr_env le) nm return (W# (int2Word# (addr2Int# a#))) BCONPtrStr _ -> -- should be eliminated during assembleBCOs @@ -90,19 +94,19 @@ lookupStaticPtr interp addr_of_label_string = do Nothing -> linkFail "GHC.ByteCode.Linker: can't find label" (unpackFS addr_of_label_string) -lookupIE :: Interp -> ItblEnv -> Name -> IO (Ptr ()) -lookupIE interp ie con_nm = +lookupIE :: Interp -> PkgsLoaded -> ItblEnv -> Name -> IO (Ptr ()) +lookupIE interp pkgs_loaded ie con_nm = case lookupNameEnv ie con_nm of Just (_, ItblPtr a) -> return (fromRemotePtr (castRemotePtr a)) Nothing -> do -- try looking up in the object files. let sym_to_find1 = nameToCLabel con_nm "con_info" - m <- lookupSymbol interp sym_to_find1 + m <- lookupHsSymbol interp pkgs_loaded con_nm "con_info" case m of Just addr -> return addr Nothing -> do -- perhaps a nullary constructor? let sym_to_find2 = nameToCLabel con_nm "static_info" - n <- lookupSymbol interp sym_to_find2 + n <- lookupHsSymbol interp pkgs_loaded con_nm "static_info" case n of Just addr -> return addr Nothing -> linkFail "GHC.ByteCode.Linker.lookupIE" @@ -110,34 +114,35 @@ lookupIE interp ie con_nm = unpackFS sym_to_find2) -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode -lookupAddr :: Interp -> AddrEnv -> Name -> IO (Ptr ()) -lookupAddr interp ae addr_nm = do +lookupAddr :: Interp -> PkgsLoaded -> AddrEnv -> Name -> IO (Ptr ()) +lookupAddr interp pkgs_loaded ae addr_nm = do case lookupNameEnv ae addr_nm of Just (_, AddrPtr ptr) -> return (fromRemotePtr ptr) Nothing -> do -- try looking up in the object files. let sym_to_find = nameToCLabel addr_nm "bytes" -- see Note [Bytes label] in GHC.Cmm.CLabel - m <- lookupSymbol interp sym_to_find + m <- lookupHsSymbol interp pkgs_loaded addr_nm "bytes" case m of Just ptr -> return ptr Nothing -> linkFail "GHC.ByteCode.Linker.lookupAddr" (unpackFS sym_to_find) -lookupPrimOp :: Interp -> PrimOp -> IO (RemotePtr ()) -lookupPrimOp interp primop = do +lookupPrimOp :: Interp -> PkgsLoaded -> PrimOp -> IO (RemotePtr ()) +lookupPrimOp interp pkgs_loaded primop = do let sym_to_find = primopToCLabel primop "closure" - m <- lookupSymbol interp (mkFastString sym_to_find) + m <- lookupHsSymbol interp pkgs_loaded (Id.idName $ primOpId primop) "closure" case m of Just p -> return (toRemotePtr p) Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE(primop)" sym_to_find resolvePtr :: Interp + -> PkgsLoaded -> LinkerEnv -> NameEnv Int -> BCOPtr -> IO ResolvedBCOPtr -resolvePtr interp le bco_ix ptr = case ptr of +resolvePtr interp pkgs_loaded le bco_ix ptr = case ptr of BCOPtrName nm | Just ix <- lookupNameEnv bco_ix nm -> return (ResolvedBCORef ix) -- ref to another BCO in this group @@ -149,20 +154,38 @@ resolvePtr interp le bco_ix ptr = case ptr of -> assertPpr (isExternalName nm) (ppr nm) $ do let sym_to_find = nameToCLabel nm "closure" - m <- lookupSymbol interp sym_to_find + m <- lookupHsSymbol interp pkgs_loaded nm "closure" case m of Just p -> return (ResolvedBCOStaticPtr (toRemotePtr p)) Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE" (unpackFS sym_to_find) BCOPtrPrimOp op - -> ResolvedBCOStaticPtr <$> lookupPrimOp interp op + -> ResolvedBCOStaticPtr <$> lookupPrimOp interp pkgs_loaded op BCOPtrBCO bco - -> ResolvedBCOPtrBCO <$> linkBCO interp le bco_ix bco + -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le bco_ix bco BCOPtrBreakArray breakarray -> withForeignRef breakarray $ \ba -> return (ResolvedBCOPtrBreakArray ba) +lookupHsSymbol :: Interp -> PkgsLoaded -> Name -> String -> IO (Maybe (Ptr ())) +lookupHsSymbol interp pkgs_loaded nm sym_suffix = do + massertPpr (isExternalName nm) (ppr nm) + let sym_to_find = nameToCLabel nm sym_suffix + pkg_id = moduleUnitId $ nameModule nm + loaded_dlls = maybe [] loaded_pkg_hs_dlls $ lookupUDFM pkgs_loaded pkg_id + + go (dll:dlls) = do + mb_ptr <- lookupSymbolInDLL interp dll sym_to_find + case mb_ptr of + Just ptr -> pure (Just ptr) + Nothing -> go dlls + go [] = + -- See Note [Symbols may not be found in pkgs_loaded] in GHC.Linker.Types + lookupSymbol interp sym_to_find + + go loaded_dlls + linkFail :: String -> String -> IO a linkFail who what = throwGhcExceptionIO (ProgramError $ ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -420,12 +420,12 @@ loadExternalPluginLib :: FilePath -> IO () loadExternalPluginLib path = do -- load library loadDLL path >>= \case - Just errmsg -> pprPanic "loadExternalPluginLib" - (vcat [ text "Can't load plugin library" - , text " Library path: " <> text path - , text " Error : " <> text errmsg - ]) - Nothing -> do + Left errmsg -> pprPanic "loadExternalPluginLib" + (vcat [ text "Can't load plugin library" + , text " Library path: " <> text path + , text " Error : " <> text errmsg + ]) + Right _ -> do -- TODO: use returned LoadedDLL? -- resolve objects resolveObjs >>= \case True -> return () ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Tc.Utils.Monad import GHC.Runtime.Interpreter import GHCi.RemoteTypes import GHC.Iface.Load +import GHCi.Message (LoadedDLL) import GHC.ByteCode.Linker import GHC.ByteCode.Asm @@ -172,7 +173,7 @@ emptyLoaderState = LoaderState -- -- The linker's symbol table is populated with RTS symbols using an -- explicit list. See rts/Linker.c for details. - where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqDSet) + where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] [] emptyUniqDSet) extendLoadedEnv :: Interp -> [(Name,ForeignHValue)] -> IO () extendLoadedEnv interp new_bindings = @@ -221,8 +222,8 @@ loadDependencies -> SrcSpan -> [Module] -> IO (LoaderState, SuccessFlag, [Linkable], PkgsLoaded) -- ^ returns the set of linkables required +-- When called, the loader state must have been initialized (see `initLoaderState`) loadDependencies interp hsc_env pls span needed_mods = do --- initLoaderState (hsc_dflags hsc_env) dl let opts = initLinkDepsOpts hsc_env -- Find what packages and linkables are required @@ -512,25 +513,25 @@ preloadLib interp hsc_env lib_paths framework_paths pls lib_spec = do DLL dll_unadorned -> do maybe_errstr <- loadDLL interp (platformSOName platform dll_unadorned) case maybe_errstr of - Nothing -> maybePutStrLn logger "done" - Just mm | platformOS platform /= OSDarwin -> + Right _ -> maybePutStrLn logger "done" + Left mm | platformOS platform /= OSDarwin -> preloadFailed mm lib_paths lib_spec - Just mm | otherwise -> do + Left mm | otherwise -> do -- As a backup, on Darwin, try to also load a .so file -- since (apparently) some things install that way - see -- ticket #8770. let libfile = ("lib" ++ dll_unadorned) <.> "so" err2 <- loadDLL interp libfile case err2 of - Nothing -> maybePutStrLn logger "done" - Just _ -> preloadFailed mm lib_paths lib_spec + Right _ -> maybePutStrLn logger "done" + Left _ -> preloadFailed mm lib_paths lib_spec return pls DLLPath dll_path -> do do maybe_errstr <- loadDLL interp dll_path case maybe_errstr of - Nothing -> maybePutStrLn logger "done" - Just mm -> preloadFailed mm lib_paths lib_spec + Right _ -> maybePutStrLn logger "done" + Left mm -> preloadFailed mm lib_paths lib_spec return pls Framework framework -> @@ -614,7 +615,7 @@ loadExpr interp hsc_env span root_ul_bco = do -- Load the necessary packages and linkables let le = linker_env pls bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)] - resolved <- linkBCO interp le bco_ix root_ul_bco + resolved <- linkBCO interp (pkgs_loaded pls) le bco_ix root_ul_bco [root_hvref] <- createBCOs interp [resolved] fhv <- mkFinalizedHValue interp root_hvref return (pls, fhv) @@ -678,7 +679,7 @@ loadDecls interp hsc_env span cbc at CompiledByteCode{..} = do , addr_env = plusNameEnv (addr_env le) bc_strs } -- Link the necessary packages and linkables - new_bindings <- linkSomeBCOs interp le2 [cbc] + new_bindings <- linkSomeBCOs interp (pkgs_loaded pls) le2 [cbc] nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings let ce2 = extendClosureEnv (closure_env le2) nms_fhvs !pls2 = pls { linker_env = le2 { closure_env = ce2 } } @@ -860,8 +861,8 @@ dynLoadObjs interp hsc_env pls at LoaderState{..} objs = do changeTempFilesLifetime tmpfs TFL_GhcSession [soFile] m <- loadDLL interp soFile case m of - Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } - Just err -> linkFail msg err + Right _ -> return $! pls { temp_sos = (libPath, libName) : temp_sos } + Left err -> linkFail msg err where msg = "GHC.Linker.Loader.dynLoadObjs: Loading temp shared object failed" @@ -901,7 +902,7 @@ dynLinkBCOs interp pls bcos = do ae2 = foldr plusNameEnv (addr_env le1) (map bc_strs cbcs) le2 = le1 { itbl_env = ie2, addr_env = ae2 } - names_and_refs <- linkSomeBCOs interp le2 cbcs + names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs -- We only want to add the external ones to the ClosureEnv let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs @@ -916,6 +917,7 @@ dynLinkBCOs interp pls bcos = do -- Link a bunch of BCOs and return references to their values linkSomeBCOs :: Interp + -> PkgsLoaded -> LinkerEnv -> [CompiledByteCode] -> IO [(Name,HValueRef)] @@ -923,7 +925,7 @@ linkSomeBCOs :: Interp -- the incoming unlinked BCOs. Each gives the -- value of the corresponding unlinked BCO -linkSomeBCOs interp le mods = foldr fun do_link mods [] +linkSomeBCOs interp pkgs_loaded le mods = foldr fun do_link mods [] where fun CompiledByteCode{..} inner accum = inner (bc_bcos : accum) @@ -932,7 +934,7 @@ linkSomeBCOs interp le mods = foldr fun do_link mods [] let flat = [ bco | bcos <- mods, bco <- bcos ] names = map unlinkedBCOName flat bco_ix = mkNameEnv (zip names [0..]) - resolved <- sequence [ linkBCO interp le bco_ix bco | bco <- flat ] + resolved <- sequence [ linkBCO interp pkgs_loaded le bco_ix bco | bco <- flat ] hvrefs <- createBCOs interp resolved return (zip names hvrefs) @@ -1094,18 +1096,18 @@ loadPackages' interp hsc_env new_pks pls = do -- Link dependents first ; pkgs' <- link pkgs deps -- Now link the package itself - ; (hs_cls, extra_cls) <- loadPackage interp hsc_env pkg_cfg + ; (hs_cls, extra_cls, loaded_dlls) <- loadPackage interp hsc_env pkg_cfg ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg | dep_pkg <- deps , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) ] - ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls trans_deps)) } + ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls loaded_dlls trans_deps)) } | otherwise = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (unitIdFS new_pkg))) -loadPackage :: Interp -> HscEnv -> UnitInfo -> IO ([LibrarySpec], [LibrarySpec]) +loadPackage :: Interp -> HscEnv -> UnitInfo -> IO ([LibrarySpec], [LibrarySpec], [RemotePtr LoadedDLL]) loadPackage interp hsc_env pkg = do let dflags = hsc_dflags hsc_env @@ -1147,7 +1149,9 @@ loadPackage interp hsc_env pkg let classifieds = hs_classifieds ++ extra_classifieds -- Complication: all the .so's must be loaded before any of the .o's. - let known_dlls = [ dll | DLLPath dll <- classifieds ] + let known_hs_dlls = [ dll | DLLPath dll <- hs_classifieds ] + known_extra_dlls = [ dll | DLLPath dll <- extra_classifieds ] + known_dlls = known_hs_dlls ++ known_extra_dlls #if defined(CAN_LOAD_DLL) dlls = [ dll | DLL dll <- classifieds ] #endif @@ -1168,10 +1172,13 @@ loadPackage interp hsc_env pkg loadFrameworks interp platform pkg -- See Note [Crash early load_dyn and locateLib] -- Crash early if can't load any of `known_dlls` - mapM_ (load_dyn interp hsc_env True) known_dlls + mapM_ (load_dyn interp hsc_env True) known_extra_dlls + loaded_dlls <- mapMaybeM (load_dyn interp hsc_env True) known_hs_dlls -- For remaining `dlls` crash early only when there is surely -- no package's DLL around ... (not is_dyn) mapM_ (load_dyn interp hsc_env (not is_dyn) . platformSOName platform) dlls +#else + let loaded_dlls = [] #endif -- After loading all the DLLs, we can load the static objects. -- Ordering isn't important here, because we do one final link @@ -1191,7 +1198,7 @@ loadPackage interp hsc_env pkg if succeeded ok then do maybePutStrLn logger "done." - return (hs_classifieds, extra_classifieds) + return (hs_classifieds, extra_classifieds, loaded_dlls) else let errmsg = text "unable to load unit `" <> pprUnitInfoForUser pkg <> text "'" in throwGhcExceptionIO (InstallationError (showSDoc dflags errmsg)) @@ -1244,19 +1251,20 @@ restriction very easily. -- can be passed directly to loadDLL. They are either fully-qualified -- ("/usr/lib/libfoo.so"), or unqualified ("libfoo.so"). In the latter case, -- loadDLL is going to search the system paths to find the library. -load_dyn :: Interp -> HscEnv -> Bool -> FilePath -> IO () +load_dyn :: Interp -> HscEnv -> Bool -> FilePath -> IO (Maybe (RemotePtr LoadedDLL)) load_dyn interp hsc_env crash_early dll = do r <- loadDLL interp dll case r of - Nothing -> return () - Just err -> + Right loaded_dll -> pure (Just loaded_dll) + Left err -> if crash_early then cmdLineErrorIO err - else + else do when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts) $ logMsg logger (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing) noSrcSpan $ withPprStyle defaultUserStyle (note err) + pure Nothing where diag_opts = initDiagOpts (hsc_dflags hsc_env) logger = hsc_logger hsc_env ===================================== compiler/GHC/Linker/MacOS.hs ===================================== @@ -172,6 +172,6 @@ loadFramework interp extraPaths rootname findLoadDLL (p:ps) errs = do { dll <- loadDLL interp (p fwk_file) ; case dll of - Nothing -> return Nothing - Just err -> findLoadDLL ps ((p ++ ": " ++ err):errs) + Right _ -> return Nothing + Left err -> findLoadDLL ps ((p ++ ": " ++ err):errs) } ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -40,7 +40,8 @@ import GHC.Prelude import GHC.Unit ( UnitId, Module ) import GHC.ByteCode.Types ( ItblEnv, AddrEnv, CompiledByteCode ) import GHC.Fingerprint.Type ( Fingerprint ) -import GHCi.RemoteTypes ( ForeignHValue ) +import GHCi.RemoteTypes ( ForeignHValue, RemotePtr ) +import GHCi.Message ( LoadedDLL ) import GHC.Types.Var ( Id ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnvList, filterNameEnv ) @@ -75,6 +76,56 @@ initialised. The LinkerEnv maps Names to actual closures (for interpreted code only), for use during linking. + +Note [Looking up symbols in the relevant objects] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In #23415, we determined that a lot of time (>10s, or even up to >35s!) was +being spent on dynamically loading symbols before actually interpreting code +when `:main` was run in GHCi. The root cause was that for each symbol we wanted +to lookup, we would traverse the list of loaded objects and try find the symbol +in each of them with dlsym (i.e. looking up a symbol was, worst case, linear in +the amount of loaded objects). + +To drastically improve load time (from +-38 seconds down to +-2s), we now: + +1. For every of the native objects loaded for a given unit, store the handles returned by `dlopen`. + - In `pkgs_loaded` of the `LoaderState`, which maps `UnitId`s to + `LoadedPkgInfo`s, where the handles live in its field `loaded_pkg_hs_dlls`. + +2. When looking up a Name (e.g. `lookupHsSymbol`), find that name's `UnitId` in + the `pkgs_loaded` mapping, + +3. And only look for the symbol (with `dlsym`) on the /handles relevant to that + unit/, rather than in every loaded object. + +Note [Symbols may not be found in pkgs_loaded] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Despite storing and looking for symbols in the relevant loaded libraries +handles for a given unit-id, as described in the note above, we may still have +to fallback to the "slow" `lookupSymbol` function (see its "fallback" call in +`lookupHsSymbol`). + +TODO: Ben: my understanding here is flawed; could you make this clearer?. + +This fallback is still needed because a given unit may be associated with +static objects (`loaded_pkg_hs_objs`) only and no dynamic libraries, but we +only `lookupSymbolInDLL` for loaded dynamic libraries. In that case, +`lookupSymbol` will do the right thing because, besides looking up the symbol +in every loaded dylib, it will end up searching the static name table and find those symbols. + +Arguably, we should rather generalise `lookupSymbolInDLL` to +`lookupSymbolInObject`, where an object may be a DLL/native object (as in +`loadNativeObj`), or e.g. a static archive, instead of having a special case +for dynamic libraries. + +This fallback is further needed because we don't look in the haskell objects +loaded for the home units (see the call to `loadModuleLinkables` in +`loadDependencies`, as opposed to the call to `loadPackages'` in the same +function which updates `pkgs_loaded`). We should ultimately keep track of the +objects loaded (probably in `objs_loaded`, for which `LinkableSet` is a bit +unsatisfactory, see a suggestion in 51c5c4eb1f2a33e4dc88e6a37b7b7c135234ce9b) +and be able to lookup symbols specifically in them too (similarly to +`lookupSymbolInDLL`). -} newtype Loader = Loader { loader_state :: MVar (Maybe LoaderState) } @@ -146,11 +197,13 @@ data LoadedPkgInfo { loaded_pkg_uid :: !UnitId , loaded_pkg_hs_objs :: ![LibrarySpec] , loaded_pkg_non_hs_objs :: ![LibrarySpec] + , loaded_pkg_hs_dlls :: ![RemotePtr LoadedDLL] + -- ^ See Note [Looking up symbols in the relevant objects] , loaded_pkg_trans_deps :: UniqDSet UnitId } instance Outputable LoadedPkgInfo where - ppr (LoadedPkgInfo uid hs_objs non_hs_objs trans_deps) = + ppr (LoadedPkgInfo uid hs_objs non_hs_objs _ trans_deps) = vcat [ppr uid , ppr hs_objs , ppr non_hs_objs @@ -159,10 +212,10 @@ instance Outputable LoadedPkgInfo where -- | Information we can use to dynamically link modules into the compiler data Linkable = LM { - linkableTime :: !UTCTime, -- ^ Time at which this linkable was built + linkableTime :: !UTCTime, -- ^ Time at which this linkable was built -- (i.e. when the bytecodes were produced, -- or the mod date on the files) - linkableModule :: !Module, -- ^ The linkable module itself + linkableModule :: !Module, -- ^ The linkable module itself linkableUnlinked :: [Unlinked] -- ^ Those files and chunks of code we have yet to link. -- ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -35,6 +35,7 @@ module GHC.Runtime.Interpreter -- * The object-code linker , initObjLinker , lookupSymbol + , lookupSymbolInDLL , lookupClosure , loadDLL , loadArchive @@ -151,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -440,57 +441,78 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + +lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of +#if defined(HAVE_INTERNAL_INTERPRETER) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) +#endif + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either -- an absolute pathname to the file, or a relative filename -- (e.g. "libfoo.so" or "foo.dll"). In the latter case, loadDLL -- searches the standard locations for the appropriate library. --- --- Returns: --- --- Nothing => success --- Just err_msg => failure -loadDLL :: Interp -> String -> IO (Maybe String) +loadDLL :: Interp -> String -> IO (Either String (RemotePtr LoadedDLL)) loadDLL interp str = interpCmd interp (LoadDLL str) loadArchive :: Interp -> String -> IO () @@ -549,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -23,6 +23,7 @@ module GHCi.Message , getMessage, putMessage, getTHMessage, putTHMessage , Pipe(..), remoteCall, remoteTHCall, readPipe, writePipe , BreakModule + , LoadedDLL ) where import Prelude -- See note [Why do we import Prelude here?] @@ -73,8 +74,9 @@ data Message a where -- These all invoke the corresponding functions in the RTS Linker API. InitLinker :: Message () LookupSymbol :: String -> Message (Maybe (RemotePtr ())) + LookupSymbolInDLL :: RemotePtr LoadedDLL -> String -> Message (Maybe (RemotePtr ())) LookupClosure :: String -> Message (Maybe HValueRef) - LoadDLL :: String -> Message (Maybe String) + LoadDLL :: String -> Message (Either String (RemotePtr LoadedDLL)) LoadArchive :: String -> Message () -- error? LoadObj :: String -> Message () -- error? UnloadObj :: String -> Message () -- error? @@ -415,6 +417,9 @@ instance Binary a => Binary (EvalResult a) -- that type isn't available here. data BreakModule +-- | A dummy type that tags pointers returned by 'LoadDLL'. +data LoadedDLL + -- SomeException can't be serialized because it contains dynamic -- types. However, we do very limited things with the exceptions that -- are thrown by interpreted computations: @@ -544,6 +549,7 @@ getMessage = do 37 -> Msg <$> return RtsRevertCAFs 38 -> Msg <$> (ResumeSeq <$> get) 39 -> Msg <$> (NewBreakModule <$> get) + 40 -> Msg <$> (LookupSymbolInDLL <$> get <*> get) _ -> error $ "Unknown Message code " ++ (show b) putMessage :: Message a -> Put @@ -588,7 +594,8 @@ putMessage m = case m of Seq a -> putWord8 36 >> put a RtsRevertCAFs -> putWord8 37 ResumeSeq a -> putWord8 38 >> put a - NewBreakModule name -> putWord8 39 >> put name + NewBreakModule name -> putWord8 39 >> put name + LookupSymbolInDLL dll str -> putWord8 40 >> put dll >> put str {- Note [Parallelize CreateBCOs serialization] ===================================== libraries/ghci/GHCi/ObjLink.hs ===================================== @@ -18,6 +18,7 @@ module GHCi.ObjLink , unloadObj , purgeObj , lookupSymbol + , lookupSymbolInDLL , lookupClosure , resolveObjs , addLibrarySearchPath @@ -27,18 +28,17 @@ module GHCi.ObjLink import Prelude -- See note [Why do we import Prelude here?] import GHCi.RemoteTypes +import GHCi.Message (LoadedDLL) import Control.Exception (throwIO, ErrorCall(..)) import Control.Monad ( when ) import Foreign.C -import Foreign.Marshal.Alloc ( free ) -import Foreign ( nullPtr ) +import Foreign.Marshal.Alloc ( alloca, free ) +import Foreign ( nullPtr, peek ) import GHC.Exts import System.Posix.Internals ( CFilePath, withFilePath, peekFilePath ) import System.FilePath ( dropExtension, normalise ) - - -- --------------------------------------------------------------------------- -- RTS Linker Interface -- --------------------------------------------------------------------------- @@ -70,6 +70,15 @@ lookupSymbol str_in = do then return Nothing else return (Just addr) +lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a)) +lookupSymbolInDLL dll str_in = do + let str = prefixUnderscore str_in + withCAString str $ \c_str -> do + addr <- c_lookupSymbolInNativeObj dll c_str + if addr == nullPtr + then return Nothing + else return (Just addr) + lookupClosure :: String -> IO (Maybe HValueRef) lookupClosure str = do m <- lookupSymbol str @@ -89,7 +98,7 @@ prefixUnderscore -- (e.g. "libfoo.so" or "foo.dll"). In the latter case, loadDLL -- searches the standard locations for the appropriate library. -- -loadDLL :: String -> IO (Maybe String) +loadDLL :: String -> IO (Either String (Ptr LoadedDLL)) -- Nothing => success -- Just err_msg => failure loadDLL str0 = do @@ -101,12 +110,16 @@ loadDLL str0 = do str | isWindowsHost = dropExtension str0 | otherwise = str0 -- - maybe_errmsg <- withFilePath (normalise str) $ \dll -> c_addDLL dll - if maybe_errmsg == nullPtr - then return Nothing - else do str <- peekCString maybe_errmsg - free maybe_errmsg - return (Just str) + (maybe_handle, maybe_errmsg) <- withFilePath (normalise str) $ \dll -> + alloca $ \errmsg_ptr -> (,) + <$> c_loadNativeObj dll errmsg_ptr + <*> peek errmsg_ptr + + if maybe_handle == nullPtr + then do str <- peekCString maybe_errmsg + free maybe_errmsg + return (Left str) + else return (Right maybe_handle) loadArchive :: String -> IO () loadArchive str = do @@ -163,7 +176,8 @@ resolveObjs = do -- Foreign declarations to RTS entry points which does the real work; -- --------------------------------------------------------------------------- -foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> IO CString +foreign import ccall unsafe "loadNativeObj" c_loadNativeObj :: CFilePath -> Ptr CString -> IO (Ptr LoadedDLL) +foreign import ccall unsafe "lookupSymbolInNativeObj" c_lookupSymbolInNativeObj :: Ptr LoadedDLL -> CString -> IO (Ptr a) foreign import ccall unsafe "initLinker_" c_initLinker_ :: CInt -> IO () foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -66,7 +66,7 @@ run m = case m of LookupClosure str -> lookupJSClosure str #else InitLinker -> initObjLinker RetainCAFs - LoadDLL str -> loadDLL str + LoadDLL str -> fmap toRemotePtr <$> loadDLL str LoadArchive str -> loadArchive str LoadObj str -> loadObj str UnloadObj str -> unloadObj str @@ -81,6 +81,8 @@ run m = case m of #endif RtsRevertCAFs -> rts_revertCAFs LookupSymbol str -> fmap toRemotePtr <$> lookupSymbol str + LookupSymbolInDLL dll str -> + fmap toRemotePtr <$> lookupSymbolInDLL (fromRemotePtr dll) str FreeHValueRefs rs -> mapM_ freeRemoteRef rs AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr EvalStmt opts r -> evalStmt opts r ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInNativeObj) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -417,11 +421,8 @@ static int linker_init_done = 0 ; #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) static void *dl_prog_handle; -static regex_t re_invalid; -static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif +regex_t re_invalid; +regex_t re_realso; #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -556,90 +551,6 @@ exitLinker( void ) { # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -/* Suppose in ghci we load a temporary SO for a module containing - f = 1 - and then modify the module, recompile, and load another temporary - SO with - f = 2 - Then as we don't unload the first SO, dlsym will find the - f = 1 - symbol whereas we want the - f = 2 - symbol. We therefore need to keep our own SO handle list, and - try SOs in the right order. */ - -typedef - struct _OpenedSO { - struct _OpenedSO* next; - void *handle; - } - OpenedSO; - -/* A list thereof. */ -static OpenedSO* openedSOs = NULL; - -static const char * -internal_dlopen(const char *dll_name) -{ - OpenedSO* o_so; - void *hdl; - const char *errmsg; - char *errmsg_copy; - - // omitted: RTLD_NOW - // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html - IF_DEBUG(linker, - debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name)); - - //-------------- Begin critical section ------------------ - // This critical section is necessary because dlerror() is not - // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008) - // Also, the error message returned must be copied to preserve it - // (see POSIX also) - - ACQUIRE_LOCK(&dl_mutex); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - errmsg = NULL; - if (hdl == NULL) { - /* dlopen failed; return a ptr to the error msg. */ - errmsg = dlerror(); - if (errmsg == NULL) errmsg = "addDLL: unknown error"; - errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL"); - strcpy(errmsg_copy, errmsg); - errmsg = errmsg_copy; - } else { - o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL"); - o_so->handle = hdl; - o_so->next = openedSOs; - openedSOs = o_so; - } - - RELEASE_LOCK(&dl_mutex); - //--------------- End critical section ------------------- - - return errmsg; -} - /* Note [RTLD_LOCAL] ~~~~~~~~~~~~~~~~~ @@ -660,11 +571,10 @@ internal_dlopen(const char *dll_name) static void * internal_dlsym(const char *symbol) { - OpenedSO* o_so; void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -672,20 +582,19 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } - for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) { - v = dlsym(o_so->handle, symbol); - if (dlerror() == NULL) { + for (ObjectCode *nc = loaded_objects; nc; nc = nc->next_loaded_object) { + if (nc->type == DYNAMIC_OBJECT) { + v = dlsym(nc->dlopen_handle, symbol); + if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; + } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -727,81 +636,35 @@ internal_dlsym(const char *symbol) { } # endif -const char * -addDLL( pathchar *dll_name ) +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - /* ------------------- ELF DLL loader ------------------- */ - -#define NMATCH 5 - regmatch_t match[NMATCH]; - const char *errmsg; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; + ACQUIRE_LOCK(&linker_mutex); - IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name)); - errmsg = internal_dlopen(dll_name); +#if defined(OBJFORMAT_MACHO) + CHECK(symbol_name[0] == '_'); + symbol_name = symbol_name+1; +#endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + void *result = dlsym(handle, symbol_name); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif - if (errmsg == NULL) { - return NULL; - } + RELEASE_LOCK(&linker_mutex); + return result; +} - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg)); - result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - return errmsg; // return original error if open fails - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)errmsg); // Free old message before creating new one - errmsg = internal_dlopen(line+match[2].rm_so); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); +const char *addDLL(pathchar* dll_name) +{ + char *errmsg; + if (loadNativeObj(dll_name, &errmsg)) { + return NULL; + } else { + ASSERT(errmsg != NULL); + return errmsg; } - return errmsg; - -# elif defined(OBJFORMAT_PEi386) - return addDLL_PEi386(dll_name, NULL); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1228,10 +1091,10 @@ void freeObjectCode (ObjectCode *oc) } if (oc->type == DYNAMIC_OBJECT) { -#if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); +#if defined(OBJFORMAT_ELF) || defined(darwin_HOST_OS) + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1896,12 +1759,20 @@ HsInt purgeObj (pathchar *path) return r; } +ObjectCode *lookupObjectByPath(pathchar *path) { + for (ObjectCode *o = objects; o; o = o->next) { + if (0 == pathcmp(o->fileName, path)) { + return o; + } + } + return NULL; +} + OStatus getObjectLoadStatus_ (pathchar *path) { - for (ObjectCode *o = objects; o; o = o->next) { - if (0 == pathcmp(o->fileName, path)) { - return o->status; - } + ObjectCode *oc = lookupObjectByPath(path); + if (oc) { + return oc->status; } return OBJECT_NOT_LOADED; } @@ -1988,25 +1859,33 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) void * loadNativeObj (pathchar *path, char **errmsg) { + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); - RELEASE_LOCK(&linker_mutex); - return r; -} + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); #else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); barf("loadNativeObj: not implemented on this platform"); -} #endif -HsInt unloadNativeObj (void *handle) +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); + } +#endif + + RELEASE_LOCK(&linker_mutex); + return r; +} + +static HsInt unloadNativeObj_(void *handle) { bool unloadedAnyObj = false; @@ -2039,11 +1918,18 @@ HsInt unloadNativeObj (void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } +HsInt unloadNativeObj(void *handle) { + ACQUIRE_LOCK(&linker_mutex); + HsInt r = unloadNativeObj_(handle); + RELEASE_LOCK(&linker_mutex); + return r; +} + /* ----------------------------------------------------------------------------- * Segment management */ ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ @@ -515,9 +511,9 @@ HsInt loadArchive_ (pathchar *path); #define USE_CONTIGUOUS_MMAP 0 #endif - HsInt isAlreadyLoaded( pathchar *path ); OStatus getObjectLoadStatus_ (pathchar *path); +ObjectCode *lookupObjectByPath(pathchar *path); HsInt loadOc( ObjectCode* oc ); ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize, bool mapped, pathchar *archiveMemberName, ===================================== rts/RtsSymbols.c ===================================== @@ -509,6 +509,7 @@ extern char **environ; SymI_HasDataProto(stg_block_putmvar) \ MAIN_CAP_SYM \ SymI_HasProto(addDLL) \ + SymI_HasProto(loadNativeObj) \ SymI_HasProto(addLibrarySearchPath) \ SymI_HasProto(removeLibrarySearchPath) \ SymI_HasProto(findSystemLibrary) \ @@ -619,6 +620,7 @@ extern char **environ; SymI_HasProto(purgeObj) \ SymI_HasProto(insertSymbol) \ SymI_HasProto(lookupSymbol) \ + SymI_HasProto(lookupSymbolInNativeObj) \ SymI_HasDataProto(stg_makeStablePtrzh) \ SymI_HasDataProto(stg_mkApUpd0zh) \ SymI_HasDataProto(stg_labelThreadzh) \ ===================================== rts/include/rts/Linker.h ===================================== @@ -90,8 +90,10 @@ void *loadNativeObj( pathchar *path, char **errmsg ); Takes the handle returned from loadNativeObj() as an argument. */ HsInt unloadNativeObj( void *handle ); +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name); + /* load a dynamic library */ -const char *addDLL( pathchar* dll_name ); +const char *addDLL(pathchar* dll_name); /* add a path to the library search path */ HsPtr addLibrarySearchPath(pathchar* dll_path); ===================================== rts/linker/Elf.c ===================================== @@ -27,11 +27,15 @@ #include "sm/OSMem.h" #include "linker/util.h" #include "linker/elf_util.h" +#include "linker/LoadNativeObjPosix.h" +#include #include #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,159 +2073,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - /* Loading the same object multiple times will lead to chaos - * as we will have two ObjectCodes but one underlying dlopen - * handle. Fail if this happens. - */ - if (getObjectLoadStatus_(path) != OBJECT_NOT_LOADED) { - copyErrmsg(errmsg, "loadNativeObj_ELF: Already loaded"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); - nc->dlopen_handle = hdl; - foreignExportsFinishedLoadingObject(); - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2271,4 +2122,71 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +extern regex_t re_invalid; +extern regex_t re_realso; + +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex); + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,214 @@ +#include "LinkerInternals.h" +#include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + +#endif /* elf + macho */ ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/linker/PEi386.c ===================================== @@ -1017,7 +1017,10 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f stgFree(dllName); IF_DEBUG(linker, debugBelch("loadArchive: read symbol %s from lib `%" PATH_FMT "'\n", symbol, dll)); - const char* result = addDLL(dll); + // We must call `addDLL_PEi386` directly rather than `addDLL` because `addDLL` + // is now a wrapper around `loadNativeObj` which acquires a lock which we + // already have here. + const char* result = addDLL_PEi386(dll, NULL); stgFree(image); @@ -1141,47 +1144,57 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; + SymbolAddr* res; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + if ((res = lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent))) + return res; + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name STG_UNUSED, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %ls\n", lbl+STRIP_LEADING_UNDERSCORE,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c ===================================== testsuite/tests/ghci/linking/dyn/T3372.hs ===================================== @@ -1,3 +1,6 @@ +-- Note: This test exercises running concurrent GHCi sessions, but +-- although this test is expected to pass, running concurrent GHCi +-- sessions is currently broken in other ways; see #24345. {-# LANGUAGE MagicHash #-} module Main where ===================================== testsuite/tests/rts/linker/T2615.hs ===================================== @@ -6,5 +6,5 @@ main = do initObjLinker RetainCAFs result <- loadDLL library_name case result of - Nothing -> putStrLn (library_name ++ " loaded successfully") - Just x -> putStrLn ("error: " ++ x) + Right _ -> putStrLn (library_name ++ " loaded successfully") + Left x -> putStrLn ("error: " ++ x) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7fae3a08236c0243cdb691ebfdfe53b95606148...39e5cb6c7092073f18a6442fac858d1a0fc70fdf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7fae3a08236c0243cdb691ebfdfe53b95606148...39e5cb6c7092073f18a6442fac858d1a0fc70fdf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 16:23:33 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Wed, 03 Apr 2024 12:23:33 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] Make template-haskell a stage1 package Message-ID: <660d8285d69f5_231e18b07458632c6@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: b39d3b68 by Teo Camarasu at 2024-04-03T17:23:17+01:00 Make template-haskell a stage1 package Promoting template-haskell from a stage0 to a stage1 package means that we can much more easily refactor template-haskell. In order to accomplish this we now compile stage0 packages using the boot compiler's version of template-haskell. This means that there are now two versions of template-haskell in play: the boot compiler's version, and the in-tree version. When compiling the stage1 compiler, we have to pick a version of template-haskell to use. During bootstrapping we want to use the same version as the final compiler. This forces the in-tree version. We are only able to use the internal interpreter with stage2 onwards. Yet, we could still use the external interpreter. The external interpreter runs splices in another process. Queries and results are seralised. This reduces our compatibility requirements from ABI compatibility with the internal interpreter to mere serialisation compatibility. We may compile GHC against another library to what the external interpreter is compiled against so long as it has exactly the same serialisation of template-haskell types. This opens up the strategy pursued in this patch. We introduce two new packages: template-haskell-in-tree and ghc-boot-th-in-tree. These package are carbon copies of template-haskell and ghc-boot-th respectively. They only differ in their name. When compiling the stage1 compiler we use these to define the Template Haskell interface for the external interpreter. Note that at this point we also have the template-haskell and ghc-boot packages in our transitive dependency closure from the boot compiler, and some packages like containers have dependencies on these to define Lift instances. Then the external interpreter should be compiled against the regular template-haskell library from the source tree. As these two packages are identical, we can then run splices. GHC stage2 is compiled as normal as well against the template-haskell library from the source tree. Resolves #23536 - - - - - 13 changed files: - compiler/ghc.cabal.in - hadrian/src/Packages.hs - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - + libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal - + libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - + libraries/template-haskell-in-tree/template-haskell-in-tree.cabal - libraries/template-haskell/Language/Haskell/TH/Syntax.hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -82,6 +82,11 @@ Flag hadrian-stage0 Default: False Manual: True +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + Library Default-Language: GHC2021 Exposed: False @@ -115,7 +120,6 @@ Library containers >= 0.6.2.1 && < 0.8, array >= 0.1 && < 0.6, filepath >= 1 && < 1.6, - template-haskell == 2.22.*, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, @@ -125,6 +129,13 @@ Library ghc-heap == @ProjectVersionMunged@, ghci == @ProjectVersionMunged@ + if flag(bootstrap-th) + Build-Depends: + template-haskell-in-tree == 2.22.* + else + Build-Depends: + template-haskell == 2.22.* + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -4,12 +4,12 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, + runGhc, semaphoreCompat, stm, templateHaskell, templateHaskellInTree, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -37,11 +37,11 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim , ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl, osString - , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell, templateHaskellInTree , terminfo, text, time, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon @@ -54,11 +54,11 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, - osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, + osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, templateHaskellInTree, terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -87,6 +87,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcBootThInTree = lib "ghc-boot-th-in-tree" ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" @@ -123,6 +124,7 @@ runGhc = util "runghc" semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" +templateHaskellInTree = lib "template-haskell-in-tree" terminfo = lib "terminfo" text = lib "text" time = lib "time" ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -35,7 +35,10 @@ extra_dependencies = where th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") - dep (p1, m1) (p2, m2) s = do + dep (p1, m1) (p2, m2) s = + -- We use the boot compiler's `template-haskell` library when building stage0, + -- so we don't need to register dependencies. + if isStage0 s then pure [] else do let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set") ways <- interpretInContext context getLibraryWays mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -27,6 +27,7 @@ import Utilities import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp)) import GHC.Toolchain.Program import GHC.Platform.ArchOS +import qualified System.Directory as IO -- | Track this file to rebuild generated files whenever it changes. trackGenerateHs :: Expr () @@ -119,6 +120,7 @@ generatePackageCode context@(Context stage pkg _ _) = do let dir = buildDir context generated f = (root -/- dir -/- "**/*.hs") ?== f && not ("//autogen/*" ?== f) go gen file = generate file context gen + generated ?> \file -> do let unpack = fromMaybe . error $ "No generator for " ++ file ++ "." (src, builder) <- unpack <$> findGenerator context file @@ -143,6 +145,22 @@ generatePackageCode context@(Context stage pkg _ _) = do when (pkg == ghcBoot) $ do root -/- "**" -/- dir -/- "GHC/Version.hs" %> go generateVersionHs root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs + when (pkg == ghcBootThInTree) $ do + let prefix = root -/- dir + prefix -/- "**/*.hs" %> \file -> do + cwd <- liftIO $ IO.getCurrentDirectory + createFileLink (cwd -/- "libraries/ghc-boot-th" -/- makeRelative prefix file) file + when (pkg == templateHaskellInTree) $ do + let prefix = root -/- dir + prefix -/- "**/*.hs" %> \file -> do + cwd <- liftIO $ IO.getCurrentDirectory + let rel = makeRelative prefix file + let rootCandidate = cwd -/- "libraries/template-haskell" -/- rel + let vendoredCandidate = cwd -/- "libraries/template-haskell" -/- "vendored-filepath" -/- rel + exists <- liftIO $ IO.doesFileExist rootCandidate + if exists + then createFileLink rootCandidate file + else createFileLink vendoredCandidate file when (pkg == compiler) $ do root -/- primopsTxt stage %> \file -> do @@ -325,6 +343,7 @@ templateRules = do templateRule "utils/runghc/runghc.cabal" $ projectVersion templateRule "libraries/ghc-boot/ghc-boot.cabal" $ projectVersion templateRule "libraries/ghc-boot-th/ghc-boot-th.cabal" $ projectVersion + templateRule "libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal" $ projectVersion templateRule "libraries/ghci/ghci.cabal" $ projectVersion templateRule "libraries/ghc-heap/ghc-heap.cabal" $ projectVersion templateRule "utils/ghc-pkg/ghc-pkg.cabal" $ projectVersion @@ -348,7 +367,6 @@ templateRules = do , interpolateVar "LlvmMaxVersion" $ replaceEq '.' ',' <$> setting LlvmMaxVersion ] - -- Generators -- | GHC wrapper scripts used for passing the path to the right package database ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,7 +158,7 @@ toolTargets = [ binary -- , ghc -- # depends on ghc library -- , runGhc -- # depends on ghc library , ghcBoot - , ghcBootTh + , ghcBootThInTree , ghcPlatform , ghcToolchain , ghcToolchainBin @@ -172,8 +172,8 @@ toolTargets = [ binary , mtl , parsec , time - , templateHaskell , text + , templateHaskellInTree , transformers , semaphoreCompat , unlit -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -93,7 +93,7 @@ stage0Packages = do , ghc , runGhc , ghcBoot - , ghcBootTh + , ghcBootThInTree , ghcPlatform , ghcHeap , ghcToolchain @@ -108,8 +108,8 @@ stage0Packages = do , parsec , semaphoreCompat , time - , templateHaskell , text + , templateHaskellInTree , transformers , unlit , hp2ps @@ -127,6 +127,10 @@ stage1Packages = do -- but not win32/unix because it depends on cross-compilation target | p == win32 = False | p == unix = False + -- we don't keep ghc-boot-in-tree and template-haskell-in-tree + -- as they are only needed for bootstrapping Template Haskell + | p == ghcBootThInTree = False + | p == templateHaskellInTree = False | otherwise = True libraries0 <- filter good_stage0_package <$> stage0Packages @@ -143,6 +147,7 @@ stage1Packages = do , deepseq , exceptions , ghc + , ghcBootTh , ghcBignum , ghcCompact , ghcExperimental @@ -156,6 +161,7 @@ stage1Packages = do , pretty , rts , semaphoreCompat + , templateHaskell , stm , unlit , xhtml ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -78,6 +78,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" + , stage0 `cabalFlag` "bootstrap-th" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" , flag UseLibzstd `cabalFlag` "with-libzstd" @@ -121,6 +122,10 @@ packageArgs = do , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ? input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ] + -------------------------------- ghcBoot ------------------------------ + , package ghcBoot ? + builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap-th") + --------------------------------- ghci --------------------------------- , package ghci ? mconcat [ @@ -151,9 +156,12 @@ packageArgs = do -- compiler comes with the same versions as the one we are building. -- builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir - , builder (Cabal Flags) ? ifM stage0 - (andM [cross, bootCross] `cabalFlag` "internal-interpreter") - (arg "internal-interpreter") + , builder (Cabal Flags) ? mconcat [ + ifM stage0 + (andM [cross, bootCross] `cabalFlag` "internal-interpreter") + (arg "internal-interpreter") + , stage0 `cabalFlag` "bootstrap-th" + ] ] ===================================== libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal ===================================== @@ -0,0 +1,39 @@ +-- WARNING: ghc-boot-th-in-tree.cabal is automatically generated from +-- ghc-boot-th.cabal-in-tree.in by ../../configure. Make sure you are editing +-- ghc-boot-th.cabal-in-tree.in, not ghc-boot-th-in-tree.cabal. + +name: ghc-boot-th-in-tree +version: 9.11 +license: BSD3 +license-file: LICENSE +category: GHC +maintainer: ghc-devs at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Shared functionality between GHC and the @template-haskell@ + library +description: This library contains various bits shared between the @ghc@ and + @template-haskell@ libraries. + . + This package exists to ensure that @template-haskell@ has a + minimal set of transitive dependencies, since it is intended to + be depended upon by user code. +cabal-version: >=1.10 +build-type: Simple +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/ghc-boot-th-in-tree + +Library + default-language: Haskell2010 + other-extensions: DeriveGeneric + default-extensions: NoImplicitPrelude + + exposed-modules: + GHC.LanguageExtensions.Type + GHC.ForeignSrcLang.Type + GHC.Lexeme + + build-depends: base >= 4.7 && < 4.21 ===================================== libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal.in ===================================== @@ -0,0 +1,39 @@ +-- WARNING: ghc-boot-th-in-tree.cabal is automatically generated from +-- ghc-boot-th.cabal-in-tree.in by ../../configure. Make sure you are editing +-- ghc-boot-th.cabal-in-tree.in, not ghc-boot-th-in-tree.cabal. + +name: ghc-boot-th-in-tree +version: @ProjectVersionMunged@ +license: BSD3 +license-file: LICENSE +category: GHC +maintainer: ghc-devs at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Shared functionality between GHC and the @template-haskell@ + library +description: This library contains various bits shared between the @ghc@ and + @template-haskell@ libraries. + . + This package exists to ensure that @template-haskell@ has a + minimal set of transitive dependencies, since it is intended to + be depended upon by user code. +cabal-version: >=1.10 +build-type: Simple +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/ghc-boot-th-in-tree + +Library + default-language: Haskell2010 + other-extensions: DeriveGeneric + default-extensions: NoImplicitPrelude + + exposed-modules: + GHC.LanguageExtensions.Type + GHC.ForeignSrcLang.Type + GHC.Lexeme + + build-depends: base >= 4.7 && < 4.21 ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -35,6 +35,11 @@ source-repository head location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/ghc-boot +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + Library default-language: Haskell2010 other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables @@ -81,7 +86,12 @@ Library filepath >= 1.3 && < 1.6, deepseq >= 1.4 && < 1.6, ghc-platform >= 0.1, - ghc-boot-th == @ProjectVersionMunged@ + if flag(bootstrap-th) + build-depends: + ghc-boot-th-in-tree == @ProjectVersionMunged@ + else + build-depends: + ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: unix >= 2.7 && < 2.9 ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -22,6 +22,11 @@ Flag internal-interpreter Default: False Manual: True +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + source-repository head type: git location: https://gitlab.haskell.org/ghc/ghc.git @@ -84,8 +89,14 @@ library filepath >= 1.4 && < 1.6, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, - template-haskell == 2.22.*, transformers >= 0.5 && < 0.7 + if flag(bootstrap-th) + Build-Depends: + template-haskell-in-tree == 2.22.* + else + Build-Depends: + template-haskell == 2.22.* + if !os(windows) Build-Depends: unix >= 2.7 && < 2.9 ===================================== libraries/template-haskell-in-tree/template-haskell-in-tree.cabal ===================================== @@ -0,0 +1,72 @@ +-- WARNING: template-haskell.cabal is automatically generated from template-haskell.cabal.in by +-- ../../configure. Make sure you are editing template-haskell.cabal.in, not +-- template-haskell.cabal. + +name: template-haskell-in-tree +version: 2.22.0.0 +-- NOTE: Don't forget to update ./changelog.md +license: BSD3 +license-file: LICENSE +category: Template Haskell +maintainer: libraries at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Support library for Template Haskell +build-type: Simple +Cabal-Version: >= 1.10 +description: + This package provides modules containing facilities for manipulating + Haskell source code using Template Haskell. + . + See for more + information. + +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/template-haskell-in-tree + +Library + default-language: Haskell2010 + other-extensions: + BangPatterns + CPP + DefaultSignatures + DeriveDataTypeable + DeriveGeneric + FlexibleInstances + RankNTypes + RoleAnnotations + ScopedTypeVariables + + exposed-modules: + Language.Haskell.TH + Language.Haskell.TH.Lib + Language.Haskell.TH.Ppr + Language.Haskell.TH.PprLib + Language.Haskell.TH.Quote + Language.Haskell.TH.Syntax + Language.Haskell.TH.LanguageExtensions + Language.Haskell.TH.CodeDo + Language.Haskell.TH.Lib.Internal + + other-modules: + Language.Haskell.TH.Lib.Map + + build-depends: + base >= 4.11 && < 4.21, + ghc-boot-th-in-tree == 9.11, + ghc-prim, + pretty == 1.1.* + + other-modules: + System.FilePath + System.FilePath.Posix + System.FilePath.Windows + hs-source-dirs: ./vendored-filepath . + default-extensions: + ImplicitPrelude + + ghc-options: -Wall + cpp-options: -DBOOTSTRAP_TH ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -34,13 +34,11 @@ module Language.Haskell.TH.Syntax -- $infix ) where -import qualified Data.Fixed as Fixed import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import System.FilePath import GHC.IO.Unsafe ( unsafeDupableInterleaveIO ) -import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Fix (MonadFix (..)) import Control.Applicative (Applicative(..)) @@ -48,35 +46,42 @@ import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO) import Control.Exception.Base (FixIOException (..)) import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar) import System.IO ( hPutStrLn, stderr ) -import Data.Char ( isAlpha, isAlphaNum, isUpper, ord ) +import Data.Char ( isAlpha, isAlphaNum, isUpper ) import Data.Int import Data.List.NonEmpty ( NonEmpty(..) ) -import Data.Void ( Void, absurd ) import Data.Word import Data.Ratio -import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) -import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), - TYPE, RuntimeRep(..), Levity(..), 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 ) import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions -import Numeric.Natural import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types +#ifdef BOOTSTRAP_TH +import GHC.Types (TYPE, RuntimeRep(..), Levity(..)) +#else +import Control.Monad (liftM) +import Data.Char (ord) +import qualified Data.Fixed as Fixed +import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) +import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), + TYPE, RuntimeRep(..), Levity(..), Multiplicity (..) ) +import GHC.CString ( unpackCString# ) +import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) +import Data.Void ( Void, absurd ) +import Numeric.Natural import Data.Array.Byte (ByteArray(..)) import GHC.Exts ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray# , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents# , copyByteArray#, newPinnedByteArray#) -import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) import GHC.ST (ST(..), runST) +#endif ----------------------------------------------------- -- @@ -1018,6 +1023,7 @@ class Lift (t :: TYPE r) where liftTyped :: Quote m => t -> Code m t +#ifndef BOOTSTRAP_TH -- If you add any instances here, consider updating test th/TH_Lift instance Lift Integer where liftTyped x = unsafeCodeCoerce (lift x) @@ -1384,10 +1390,11 @@ rightName = 'Right nonemptyName :: Name nonemptyName = '(:|) +#endif oneName, manyName :: Name -oneName = 'One -manyName = 'Many +oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" +manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" ----------------------------------------------------- -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b39d3b6856075fc776cf1eca5780b791c1d09be7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b39d3b6856075fc776cf1eca5780b791c1d09be7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 16:30:21 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Wed, 03 Apr 2024 12:30:21 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] Make template-haskell a stage1 package Message-ID: <660d841da5fdb_231e18c63270645c1@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: 3ff2cd57 by Teo Camarasu at 2024-04-03T17:29:51+01:00 Make template-haskell a stage1 package Promoting template-haskell from a stage0 to a stage1 package means that we can much more easily refactor template-haskell. In order to accomplish this we now compile stage0 packages using the boot compiler's version of template-haskell. This means that there are now two versions of template-haskell in play: the boot compiler's version, and the in-tree version. When compiling the stage1 compiler, we have to pick a version of template-haskell to use. During bootstrapping we want to use the same version as the final compiler. This forces the in-tree version. We are only able to use the internal interpreter with stage2 onwards. Yet, we could still use the external interpreter. The external interpreter runs splices in another process. Queries and results are seralised. This reduces our compatibility requirements from ABI compatibility with the internal interpreter to mere serialisation compatibility. We may compile GHC against another library to what the external interpreter is compiled against so long as it has exactly the same serialisation of template-haskell types. This opens up the strategy pursued in this patch. We introduce two new packages: template-haskell-in-tree and ghc-boot-th-in-tree. These package are carbon copies of template-haskell and ghc-boot-th respectively. They only differ in their name. When compiling the stage1 compiler we use these to define the Template Haskell interface for the external interpreter. Note that at this point we also have the template-haskell and ghc-boot packages in our transitive dependency closure from the boot compiler, and some packages like containers have dependencies on these to define Lift instances. Then the external interpreter should be compiled against the regular template-haskell library from the source tree. As these two packages are identical, we can then run splices. GHC stage2 is compiled as normal as well against the template-haskell library from the source tree. Resolves #23536 - - - - - 13 changed files: - compiler/ghc.cabal.in - hadrian/src/Packages.hs - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - + libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal - + libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - + libraries/template-haskell-in-tree/template-haskell-in-tree.cabal - libraries/template-haskell/Language/Haskell/TH/Syntax.hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -82,6 +82,11 @@ Flag hadrian-stage0 Default: False Manual: True +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + Library Default-Language: GHC2021 Exposed: False @@ -115,7 +120,6 @@ Library containers >= 0.6.2.1 && < 0.8, array >= 0.1 && < 0.6, filepath >= 1 && < 1.6, - template-haskell == 2.22.*, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, @@ -125,6 +129,13 @@ Library ghc-heap == @ProjectVersionMunged@, ghci == @ProjectVersionMunged@ + if flag(bootstrap-th) + Build-Depends: + template-haskell-in-tree == 2.22.* + else + Build-Depends: + template-haskell == 2.22.* + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -4,12 +4,12 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, + runGhc, semaphoreCompat, stm, templateHaskell, templateHaskellInTree, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -37,11 +37,11 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim , ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl, osString - , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell, templateHaskellInTree , terminfo, text, time, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon @@ -54,11 +54,11 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, - osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, + osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, templateHaskellInTree, terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -87,6 +87,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcBootThInTree = lib "ghc-boot-th-in-tree" ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" @@ -123,6 +124,7 @@ runGhc = util "runghc" semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" +templateHaskellInTree = lib "template-haskell-in-tree" terminfo = lib "terminfo" text = lib "text" time = lib "time" ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -35,7 +35,10 @@ extra_dependencies = where th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") - dep (p1, m1) (p2, m2) s = do + dep (p1, m1) (p2, m2) s = + -- We use the boot compiler's `template-haskell` library when building stage0, + -- so we don't need to register dependencies. + if isStage0 s then pure [] else do let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set") ways <- interpretInContext context getLibraryWays mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -27,6 +27,7 @@ import Utilities import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp)) import GHC.Toolchain.Program import GHC.Platform.ArchOS +import qualified System.Directory as IO -- | Track this file to rebuild generated files whenever it changes. trackGenerateHs :: Expr () @@ -119,6 +120,7 @@ generatePackageCode context@(Context stage pkg _ _) = do let dir = buildDir context generated f = (root -/- dir -/- "**/*.hs") ?== f && not ("//autogen/*" ?== f) go gen file = generate file context gen + generated ?> \file -> do let unpack = fromMaybe . error $ "No generator for " ++ file ++ "." (src, builder) <- unpack <$> findGenerator context file @@ -143,6 +145,22 @@ generatePackageCode context@(Context stage pkg _ _) = do when (pkg == ghcBoot) $ do root -/- "**" -/- dir -/- "GHC/Version.hs" %> go generateVersionHs root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs + when (pkg == ghcBootThInTree) $ do + let prefix = root -/- dir + prefix -/- "**/*.hs" %> \file -> do + cwd <- liftIO $ IO.getCurrentDirectory + createFileLink (cwd -/- "libraries/ghc-boot-th" -/- makeRelative prefix file) file + when (pkg == templateHaskellInTree) $ do + let prefix = root -/- dir + prefix -/- "**/*.hs" %> \file -> do + cwd <- liftIO $ IO.getCurrentDirectory + let rel = makeRelative prefix file + let rootCandidate = cwd -/- "libraries/template-haskell" -/- rel + let vendoredCandidate = cwd -/- "libraries/template-haskell" -/- "vendored-filepath" -/- rel + exists <- liftIO $ IO.doesFileExist rootCandidate + if exists + then createFileLink rootCandidate file + else createFileLink vendoredCandidate file when (pkg == compiler) $ do root -/- primopsTxt stage %> \file -> do @@ -325,6 +343,7 @@ templateRules = do templateRule "utils/runghc/runghc.cabal" $ projectVersion templateRule "libraries/ghc-boot/ghc-boot.cabal" $ projectVersion templateRule "libraries/ghc-boot-th/ghc-boot-th.cabal" $ projectVersion + templateRule "libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal" $ projectVersion templateRule "libraries/ghci/ghci.cabal" $ projectVersion templateRule "libraries/ghc-heap/ghc-heap.cabal" $ projectVersion templateRule "utils/ghc-pkg/ghc-pkg.cabal" $ projectVersion @@ -348,7 +367,6 @@ templateRules = do , interpolateVar "LlvmMaxVersion" $ replaceEq '.' ',' <$> setting LlvmMaxVersion ] - -- Generators -- | GHC wrapper scripts used for passing the path to the right package database ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,7 +158,7 @@ toolTargets = [ binary -- , ghc -- # depends on ghc library -- , runGhc -- # depends on ghc library , ghcBoot - , ghcBootTh + , ghcBootThInTree , ghcPlatform , ghcToolchain , ghcToolchainBin @@ -172,8 +172,8 @@ toolTargets = [ binary , mtl , parsec , time - , templateHaskell , text + , templateHaskellInTree , transformers , semaphoreCompat , unlit -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -93,7 +93,7 @@ stage0Packages = do , ghc , runGhc , ghcBoot - , ghcBootTh + , ghcBootThInTree , ghcPlatform , ghcHeap , ghcToolchain @@ -108,8 +108,8 @@ stage0Packages = do , parsec , semaphoreCompat , time - , templateHaskell , text + , templateHaskellInTree , transformers , unlit , hp2ps @@ -127,6 +127,10 @@ stage1Packages = do -- but not win32/unix because it depends on cross-compilation target | p == win32 = False | p == unix = False + -- we don't keep ghc-boot-in-tree and template-haskell-in-tree + -- as they are only needed for bootstrapping Template Haskell + | p == ghcBootThInTree = False + | p == templateHaskellInTree = False | otherwise = True libraries0 <- filter good_stage0_package <$> stage0Packages @@ -143,6 +147,7 @@ stage1Packages = do , deepseq , exceptions , ghc + , ghcBootTh , ghcBignum , ghcCompact , ghcExperimental @@ -156,6 +161,7 @@ stage1Packages = do , pretty , rts , semaphoreCompat + , templateHaskell , stm , unlit , xhtml ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -78,6 +78,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" + , stage0 `cabalFlag` "bootstrap-th" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" , flag UseLibzstd `cabalFlag` "with-libzstd" @@ -121,6 +122,10 @@ packageArgs = do , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ? input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ] + -------------------------------- ghcBoot ------------------------------ + , package ghcBoot ? + builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap-th") + --------------------------------- ghci --------------------------------- , package ghci ? mconcat [ @@ -151,9 +156,12 @@ packageArgs = do -- compiler comes with the same versions as the one we are building. -- builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir - , builder (Cabal Flags) ? ifM stage0 - (andM [cross, bootCross] `cabalFlag` "internal-interpreter") - (arg "internal-interpreter") + , builder (Cabal Flags) ? mconcat [ + ifM stage0 + (andM [cross, bootCross] `cabalFlag` "internal-interpreter") + (arg "internal-interpreter") + , stage0 `cabalFlag` "bootstrap-th" + ] ] ===================================== libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal ===================================== @@ -0,0 +1,39 @@ +-- WARNING: ghc-boot-th-in-tree.cabal is automatically generated from +-- ghc-boot-th.cabal-in-tree.in by ../../configure. Make sure you are editing +-- ghc-boot-th.cabal-in-tree.in, not ghc-boot-th-in-tree.cabal. + +name: ghc-boot-th-in-tree +version: 9.11 +license: BSD3 +license-file: LICENSE +category: GHC +maintainer: ghc-devs at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Shared functionality between GHC and the @template-haskell@ + library +description: This library contains various bits shared between the @ghc@ and + @template-haskell@ libraries. + . + This package exists to ensure that @template-haskell@ has a + minimal set of transitive dependencies, since it is intended to + be depended upon by user code. +cabal-version: >=1.10 +build-type: Simple +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/ghc-boot-th-in-tree + +Library + default-language: Haskell2010 + other-extensions: DeriveGeneric + default-extensions: NoImplicitPrelude + + exposed-modules: + GHC.LanguageExtensions.Type + GHC.ForeignSrcLang.Type + GHC.Lexeme + + build-depends: base >= 4.7 && < 4.21 ===================================== libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal.in ===================================== @@ -0,0 +1,39 @@ +-- WARNING: ghc-boot-th-in-tree.cabal is automatically generated from +-- ghc-boot-th.cabal-in-tree.in by ../../configure. Make sure you are editing +-- ghc-boot-th.cabal-in-tree.in, not ghc-boot-th-in-tree.cabal. + +name: ghc-boot-th-in-tree +version: @ProjectVersionMunged@ +license: BSD3 +license-file: LICENSE +category: GHC +maintainer: ghc-devs at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Shared functionality between GHC and the @template-haskell@ + library +description: This library contains various bits shared between the @ghc@ and + @template-haskell@ libraries. + . + This package exists to ensure that @template-haskell@ has a + minimal set of transitive dependencies, since it is intended to + be depended upon by user code. +cabal-version: >=1.10 +build-type: Simple +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/ghc-boot-th-in-tree + +Library + default-language: Haskell2010 + other-extensions: DeriveGeneric + default-extensions: NoImplicitPrelude + + exposed-modules: + GHC.LanguageExtensions.Type + GHC.ForeignSrcLang.Type + GHC.Lexeme + + build-depends: base >= 4.7 && < 4.21 ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -35,6 +35,11 @@ source-repository head location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/ghc-boot +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + Library default-language: Haskell2010 other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables @@ -81,7 +86,12 @@ Library filepath >= 1.3 && < 1.6, deepseq >= 1.4 && < 1.6, ghc-platform >= 0.1, - ghc-boot-th == @ProjectVersionMunged@ + if flag(bootstrap-th) + build-depends: + ghc-boot-th-in-tree == @ProjectVersionMunged@ + else + build-depends: + ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: unix >= 2.7 && < 2.9 ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -22,6 +22,11 @@ Flag internal-interpreter Default: False Manual: True +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + source-repository head type: git location: https://gitlab.haskell.org/ghc/ghc.git @@ -84,8 +89,14 @@ library filepath >= 1.4 && < 1.6, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, - template-haskell == 2.22.*, transformers >= 0.5 && < 0.7 + if flag(bootstrap-th) + Build-Depends: + template-haskell-in-tree == 2.22.* + else + Build-Depends: + template-haskell == 2.22.* + if !os(windows) Build-Depends: unix >= 2.7 && < 2.9 ===================================== libraries/template-haskell-in-tree/template-haskell-in-tree.cabal ===================================== @@ -0,0 +1,72 @@ +-- WARNING: template-haskell.cabal is automatically generated from template-haskell.cabal.in by +-- ../../configure. Make sure you are editing template-haskell.cabal.in, not +-- template-haskell.cabal. + +name: template-haskell-in-tree +version: 2.22.0.0 +-- NOTE: Don't forget to update ./changelog.md +license: BSD3 +license-file: LICENSE +category: Template Haskell +maintainer: libraries at haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +synopsis: Support library for Template Haskell +build-type: Simple +Cabal-Version: >= 1.10 +description: + This package provides modules containing facilities for manipulating + Haskell source code using Template Haskell. + . + See for more + information. + +extra-source-files: changelog.md + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/template-haskell-in-tree + +Library + default-language: Haskell2010 + other-extensions: + BangPatterns + CPP + DefaultSignatures + DeriveDataTypeable + DeriveGeneric + FlexibleInstances + RankNTypes + RoleAnnotations + ScopedTypeVariables + + exposed-modules: + Language.Haskell.TH + Language.Haskell.TH.Lib + Language.Haskell.TH.Ppr + Language.Haskell.TH.PprLib + Language.Haskell.TH.Quote + Language.Haskell.TH.Syntax + Language.Haskell.TH.LanguageExtensions + Language.Haskell.TH.CodeDo + Language.Haskell.TH.Lib.Internal + + other-modules: + Language.Haskell.TH.Lib.Map + + build-depends: + base >= 4.11 && < 4.21, + ghc-boot-th-in-tree == 9.11, + ghc-prim, + pretty == 1.1.* + + other-modules: + System.FilePath + System.FilePath.Posix + System.FilePath.Windows + hs-source-dirs: ./vendored-filepath . + default-extensions: + ImplicitPrelude + + ghc-options: -Wall + cpp-options: -DBOOTSTRAP_TH ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -34,13 +34,11 @@ module Language.Haskell.TH.Syntax -- $infix ) where -import qualified Data.Fixed as Fixed import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import System.FilePath import GHC.IO.Unsafe ( unsafeDupableInterleaveIO ) -import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Fix (MonadFix (..)) import Control.Applicative (Applicative(..)) @@ -48,35 +46,42 @@ import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO) import Control.Exception.Base (FixIOException (..)) import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar) import System.IO ( hPutStrLn, stderr ) -import Data.Char ( isAlpha, isAlphaNum, isUpper, ord ) +import Data.Char ( isAlpha, isAlphaNum, isUpper ) import Data.Int import Data.List.NonEmpty ( NonEmpty(..) ) -import Data.Void ( Void, absurd ) import Data.Word import Data.Ratio -import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) -import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), - TYPE, RuntimeRep(..), Levity(..), 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 ) import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions -import Numeric.Natural import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types +#ifdef BOOTSTRAP_TH +import GHC.Types (TYPE, RuntimeRep(..), Levity(..)) +#else +import Control.Monad (liftM) +import Data.Char (ord) +import qualified Data.Fixed as Fixed +import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) +import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), + TYPE, RuntimeRep(..), Levity(..) ) +import GHC.CString ( unpackCString# ) +import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) +import Data.Void ( Void, absurd ) +import Numeric.Natural import Data.Array.Byte (ByteArray(..)) import GHC.Exts ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray# , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents# , copyByteArray#, newPinnedByteArray#) -import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) import GHC.ST (ST(..), runST) +#endif ----------------------------------------------------- -- @@ -1018,6 +1023,7 @@ class Lift (t :: TYPE r) where liftTyped :: Quote m => t -> Code m t +#ifndef BOOTSTRAP_TH -- If you add any instances here, consider updating test th/TH_Lift instance Lift Integer where liftTyped x = unsafeCodeCoerce (lift x) @@ -1384,10 +1390,11 @@ rightName = 'Right nonemptyName :: Name nonemptyName = '(:|) +#endif oneName, manyName :: Name -oneName = 'One -manyName = 'Many +oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" +manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" ----------------------------------------------------- -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ff2cd57e34e21ff3ea70f3f797b97972578f898 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ff2cd57e34e21ff3ea70f3f797b97972578f898 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 16:43:34 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 03 Apr 2024 12:43:34 -0400 Subject: [Git][ghc/ghc][wip/T23109] 44 commits: th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Message-ID: <660d873667f2_231e18e3bc5065477@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - ded706c6 by Simon Peyton Jones at 2024-04-03T12:16:56+01:00 Make newtype instances opaque I think this will help with #23109 Wibbles Allow SelCo for newtype classes Experimental change Wibble Furher wibbles Further improvments Further wibbles esp exprIsConLike Run classop rule first Newtype classops are small needs comments - - - - - 15 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37dafd12daa5f6f17b656c5b5494bce4fe7fe80d...ded706c61bca3c762b6fdc4ab1ea8b6790066383 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37dafd12daa5f6f17b656c5b5494bce4fe7fe80d...ded706c61bca3c762b6fdc4ab1ea8b6790066383 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 16:43:58 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 03 Apr 2024 12:43:58 -0400 Subject: [Git][ghc/ghc][wip/spj-unf-size] 47 commits: th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Message-ID: <660d874e8b23d_231e18f05b54663e3@gitlab.mail> Simon Peyton Jones pushed to branch wip/spj-unf-size at Glasgow Haskell Compiler / GHC Commits: 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - d3453235 by Simon Peyton Jones at 2024-04-03T12:19:16+01:00 Work in progress on unfoldings re-engineering - - - - - 33629f76 by Simon Peyton Jones at 2024-04-03T12:21:03+01:00 Fix a bad, subtle bug in exprIsConApp_maybe In extend_in_scope We were simply overwriting useful bindings in the in-scope set, notably ones that had unfoldings. That could lead to repeated simplifier iterations. - - - - - fb548752 by Simon Peyton Jones at 2024-04-03T12:21:03+01:00 Minor refactoring... Plus: don't be so eager to inline when argument is a non-value, but has some struture. We want *some* incentive though. - - - - - 1a2c37f0 by Simon Peyton Jones at 2024-04-03T12:23:33+01:00 Adjust * Reduce caseElimDiscount to 10 Example: f_nand in spectral/hartel/event is quite big but was still getting inlined; that make f_simulate too big for SpecConstr * Increase jumpSize. Not so much cheaper than tail calls. I'm trying making them the same size. - - - - - 15 changed files: - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/17174a9f2574c5186a7f82a68496f40b25de8e03...1a2c37f050c7bd8258fc37c1d4b8997f8cb81708 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/17174a9f2574c5186a7f82a68496f40b25de8e03...1a2c37f050c7bd8258fc37c1d4b8997f8cb81708 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 16:44:27 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 03 Apr 2024 12:44:27 -0400 Subject: [Git][ghc/ghc][wip/T24462] 50 commits: rts: Fix TSAN_ENABLED CPP guard Message-ID: <660d876b8861c_231e18f331446711a@gitlab.mail> Simon Peyton Jones pushed to branch wip/T24462 at Glasgow Haskell Compiler / GHC Commits: c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 084d00c6 by Simon Peyton Jones at 2024-04-03T10:24:59+01:00 Don't inline any old coercion Just an experiment for #24462 - - - - - 15 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81e4315aec692d4c8bf2c2133ab4f7ee463b7ec9...084d00c6100356e20e0e51f490775cfe4cdae62f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81e4315aec692d4c8bf2c2133ab4f7ee463b7ec9...084d00c6100356e20e0e51f490775cfe4cdae62f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 17:53:23 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 03 Apr 2024 13:53:23 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 2 commits: rts: Make addDLL a wrapper around loadNativeObj Message-ID: <660d9793cdf7b_231e18173c4e4770ba@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 37b17f4e by Rodrigo Mesquita at 2024-04-03T18:53:01+01:00 rts: Make addDLL a wrapper around loadNativeObj Rewrite the implementation of `addDLL` as a wrapper around the more principled `loadNativeObj` rts linker function. The latter should be preferred while the former is preserved for backwards compatibility. `loadNativeObj` was previously only available on ELF platforms, so this commit further refactors the rts linker to transform loadNativeObj_ELF into loadNativeObj_POSIX, which is available in ELF and MachO platforms. The refactor made it possible to remove the `dl_mutex` mutex in favour of always using `linker_mutex` (rather than a combination of both). Lastly, we implement `loadNativeObj` for Windows too. - - - - - 83e7e694 by Rodrigo Mesquita at 2024-04-03T18:53:01+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 18 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Types.hs - libraries/ghci/GHCi/ObjLink.hs - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/include/rts/Linker.h - rts/linker/Elf.c - rts/linker/Elf.h - + rts/linker/LoadNativeObjPosix.c - + rts/linker/LoadNativeObjPosix.h - rts/linker/PEi386.c - rts/linker/PEi386.h - rts/rts.cabal - testsuite/tests/ghci/linking/dyn/T3372.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.FM import GHC.Unit import GHC.Unit.Env @@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m () setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger + lookup_cache <- liftIO $ newMVar emptyUFM -- Interpreter interp <- if @@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do } s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader - return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader)) + return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache)) -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) @@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do , jsInterpFinderOpts = initFinderOpts dflags , jsInterpFinderCache = hsc_FC hsc_env } - return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader)) + return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache)) -- Internal interpreter | otherwise @@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) do loader <- liftIO Loader.uninitializedLoader - return (Just (Interp InternalInterp loader)) + return (Just (Interp InternalInterp loader lookup_cache)) #else return Nothing #endif ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2665,7 +2665,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do case interp of -- always generate JS code for the JS interpreter (no bytecode!) - Interp (ExternalInterp (ExtJS i)) _ -> + Interp (ExternalInterp (ExtJS i)) _ _ -> jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -152,22 +152,22 @@ The main pieces are: - implementation of Template Haskell (GHCi.TH) - a few other things needed to run interpreted code -- top-level iserv directory, containing the codefor the external - server. This is a fairly simple wrapper, most of the functionality +- top-level iserv directory, containing the code for the external + server. This is a fairly simple wrapper, most of the functionality is provided by modules in libraries/ghci. - This module which provides the interface to the server used by the rest of GHC. -GHC works with and without -fexternal-interpreter. With the flag, all -interpreted code is run by the iserv binary. Without the flag, +GHC works with and without -fexternal-interpreter. With the flag, all +interpreted code is run by the iserv binary. Without the flag, interpreted code is run in the same process as GHC. Things that do not work with -fexternal-interpreter ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ dynCompileExpr cannot work, because we have no way to run code of an -unknown type in the remote process. This API fails with an error +unknown type in the remote process. This API fails with an error message if it is used with -fexternal-interpreter. Other Notes on Remote GHCi @@ -441,52 +441,71 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) -lookupSymbol interp str = case interpInstance interp of +lookupSymbol interp str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #endif - - ExternalInterp ext -> case ext of - ExtIServ i -> withIServ i $ \inst -> do - -- Profiling of GHCi showed a lot of time and allocation spent - -- making cross-process LookupSymbol calls, so I added a GHC-side - -- cache which sped things up quite a lot. We have to be careful - -- to purge this cache when unloading code though. - cache <- readMVar (instLookupSymbolCache inst) - case lookupUFM cache str of - Just p -> return (Just p) - Nothing -> do - m <- uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) - case m of - Nothing -> return Nothing - Just r -> do - let p = fromRemotePtr r - cache' = addToUFM cache str p - modifyMVar_ (instLookupSymbolCache inst) (const (pure cache')) - return (Just p) - - ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbol (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) -lookupSymbolInDLL interp dll str = case interpInstance interp of +lookupSymbolInDLL interp dll str = withSymbolCache interp str $ + case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) #endif - ExternalInterp _ -> panic "lookupSymbolInDLL: not implemented for external interpreter" -- FIXME + ExternalInterp ext -> case ext of + ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do + uninterruptibleMask_ $ + sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) lookupClosure :: Interp -> String -> IO (Maybe HValueRef) lookupClosure interp str = interpCmd interp (LookupClosure str) +-- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' +-- which maps symbols to the address where they are loaded. +-- When there's a cache hit we simply return the cached address, when there is +-- a miss we run the action which determines the symbol's address and populate +-- the cache with the answer. +withSymbolCache :: Interp + -> FastString + -- ^ The symbol we are looking up in the cache + -> IO (Maybe (Ptr ())) + -- ^ An action which determines the address of the symbol we + -- are looking up in the cache, which is run if there is a + -- cache miss. The result will be cached. + -> IO (Maybe (Ptr ())) +withSymbolCache interp str determine_addr = do + + -- Profiling of GHCi showed a lot of time and allocation spent + -- making cross-process LookupSymbol calls, so I added a GHC-side + -- cache which sped things up quite a lot. We have to be careful + -- to purge this cache when unloading code though. + -- + -- The analysis in #23415 further showed this cache should also benefit the + -- internal interpreter's loading times, and needn't be used by the external + -- interpreter only. + cache <- readMVar (interpLookupSymbolCache interp) + case lookupUFM cache str of + Just p -> return (Just p) + Nothing -> do + + maddr <- determine_addr + case maddr of + Nothing -> return Nothing + Just p -> do + let upd_cache cache' = addToUFM cache' str p + modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) + return (Just p) + purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> pure () -#endif - ExternalInterp ext -> withExtInterpMaybe ext $ \case - Nothing -> pure () -- interpreter stopped, nothing to do - Just inst -> modifyMVar_ (instLookupSymbolCache inst) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -552,11 +571,9 @@ spawnIServ conf = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = process , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = () } pure inst ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Utils.Panic import GHC.Utils.Error (logInfo) import GHC.Utils.Outputable (text) import GHC.Data.FastString -import GHC.Types.Unique.FM import Control.Concurrent import Control.Monad @@ -178,11 +177,9 @@ spawnJSInterp cfg = do } pending_frees <- newMVar [] - lookup_cache <- newMVar emptyUFM let inst = ExtInterpInstance { instProcess = proc , instPendingFrees = pending_frees - , instLookupSymbolCache = lookup_cache , instExtra = extra } ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -51,6 +51,9 @@ data Interp = Interp , interpLoader :: !Loader -- ^ Interpreter loader + + , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + -- ^ LookupSymbol cache } data InterpInstance @@ -108,9 +111,6 @@ data ExtInterpInstance c = ExtInterpInstance -- Finalizers for ForeignRefs can append values to this list -- asynchronously. - , instLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) - -- ^ LookupSymbol cache - , instExtra :: !c -- ^ Instance specific extra fields } ===================================== libraries/ghci/GHCi/ObjLink.hs ===================================== @@ -74,7 +74,7 @@ lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a)) lookupSymbolInDLL dll str_in = do let str = prefixUnderscore str_in withCAString str $ \c_str -> do - addr <- c_lookupSymbolInDLL dll c_str + addr <- c_lookupSymbolInNativeObj dll c_str if addr == nullPtr then return Nothing else return (Just addr) @@ -99,8 +99,6 @@ prefixUnderscore -- searches the standard locations for the appropriate library. -- loadDLL :: String -> IO (Either String (Ptr LoadedDLL)) --- Nothing => success --- Just err_msg => failure loadDLL str0 = do let -- On Windows, addDLL takes a filename without an extension, because @@ -112,7 +110,7 @@ loadDLL str0 = do -- (maybe_handle, maybe_errmsg) <- withFilePath (normalise str) $ \dll -> alloca $ \errmsg_ptr -> (,) - <$> c_addDLL dll errmsg_ptr + <$> c_loadNativeObj dll errmsg_ptr <*> peek errmsg_ptr if maybe_handle == nullPtr @@ -176,8 +174,8 @@ resolveObjs = do -- Foreign declarations to RTS entry points which does the real work; -- --------------------------------------------------------------------------- -foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> Ptr CString -> IO (Ptr LoadedDLL) -foreign import ccall unsafe "lookupSymbolInDLL" c_lookupSymbolInDLL :: Ptr LoadedDLL -> CString -> IO (Ptr a) +foreign import ccall unsafe "loadNativeObj" c_loadNativeObj :: CFilePath -> Ptr CString -> IO (Ptr LoadedDLL) +foreign import ccall unsafe "lookupSymbolInNativeObj" c_lookupSymbolInNativeObj :: Ptr LoadedDLL -> CString -> IO (Ptr a) foreign import ccall unsafe "initLinker_" c_initLinker_ :: CInt -> IO () foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int ===================================== rts/Linker.c ===================================== @@ -77,6 +77,10 @@ # include #endif +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) +# include "linker/LoadNativeObjPosix.h" +#endif + #if defined(dragonfly_HOST_OS) #include #endif @@ -130,7 +134,7 @@ extern void iconv(); - Indexing (e.g. ocVerifyImage and ocGetNames) - Initialization (e.g. ocResolve) - RunInit (e.g. ocRunInit) - - Lookup (e.g. lookupSymbol) + - Lookup (e.g. lookupSymbol/lookupSymbolInNativeObj) This is to enable lazy loading of symbols. Eager loading is problematic as it means that all symbols must be available, even those which we will @@ -417,11 +421,8 @@ static int linker_init_done = 0 ; #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) static void *dl_prog_handle; -static regex_t re_invalid; -static regex_t re_realso; -#if defined(THREADED_RTS) -Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section -#endif +regex_t re_invalid; +regex_t re_realso; #endif void initLinker (void) @@ -455,9 +456,6 @@ initLinker_ (int retain_cafs) #if defined(THREADED_RTS) initMutex(&linker_mutex); -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - initMutex(&dl_mutex); -#endif #endif symhash = allocStrHashTable(); @@ -520,9 +518,6 @@ exitLinker( void ) { if (linker_init_done == 1) { regfree(&re_invalid); regfree(&re_realso); -#if defined(THREADED_RTS) - closeMutex(&dl_mutex); -#endif } #endif if (linker_init_done == 1) { @@ -556,87 +551,6 @@ exitLinker( void ) { # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -/* Suppose in ghci we load a temporary SO for a module containing - f = 1 - and then modify the module, recompile, and load another temporary - SO with - f = 2 - Then as we don't unload the first SO, dlsym will find the - f = 1 - symbol whereas we want the - f = 2 - symbol. We therefore need to keep our own SO handle list, and - try SOs in the right order. */ - -typedef - struct _OpenedSO { - struct _OpenedSO* next; - void *handle; - } - OpenedSO; - -/* A list thereof. */ -static OpenedSO* openedSOs = NULL; - -static void * -internal_dlopen(const char *dll_name, const char **errmsg_ptr) -{ - OpenedSO* o_so; - void *hdl; - - // omitted: RTLD_NOW - // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html - IF_DEBUG(linker, - debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name)); - - //-------------- Begin critical section ------------------ - // This critical section is necessary because dlerror() is not - // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008) - // Also, the error message returned must be copied to preserve it - // (see POSIX also) - - ACQUIRE_LOCK(&dl_mutex); - - // When dlopen() loads a profiled dynamic library, it calls the - // ctors which will call registerCcsList() to append the defined - // CostCentreStacks to CCS_LIST. This execution path starting from - // addDLL() was only protected by dl_mutex previously. However, - // another thread may be doing other things with the RTS linker - // that transitively calls refreshProfilingCCSs() which also - // accesses CCS_LIST, and those execution paths are protected by - // linker_mutex. So there's a risk of data race that may lead to - // segfaults (#24423), and we need to ensure the ctors are also - // protected by ccs_mutex. -#if defined(PROFILING) - ACQUIRE_LOCK(&ccs_mutex); -#endif - - hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ - -#if defined(PROFILING) - RELEASE_LOCK(&ccs_mutex); -#endif - - if (hdl == NULL) { - /* dlopen failed; return a ptr to the error msg. */ - char *errmsg = dlerror(); - if (errmsg == NULL) errmsg = "addDLL: unknown error"; - char *errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL"); - strcpy(errmsg_copy, errmsg); - *errmsg_ptr = errmsg_copy; - } else { - o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL"); - o_so->handle = hdl; - o_so->next = openedSOs; - openedSOs = o_so; - } - - RELEASE_LOCK(&dl_mutex); - //--------------- End critical section ------------------- - - return hdl; -} - /* Note [RTLD_LOCAL] ~~~~~~~~~~~~~~~~~ @@ -657,11 +571,10 @@ internal_dlopen(const char *dll_name, const char **errmsg_ptr) static void * internal_dlsym(const char *symbol) { - OpenedSO* o_so; void *v; - // We acquire dl_mutex as concurrent dl* calls may alter dlerror - ACQUIRE_LOCK(&dl_mutex); + // concurrent dl* calls may alter dlerror + ASSERT_LOCK_HELD(&linker_mutex); // clears dlerror dlerror(); @@ -669,20 +582,19 @@ internal_dlsym(const char *symbol) { // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } - for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) { - v = dlsym(o_so->handle, symbol); - if (dlerror() == NULL) { + for (ObjectCode *nc = loaded_objects; nc; nc = nc->next_loaded_object) { + if (nc->type == DYNAMIC_OBJECT) { + v = dlsym(nc->dlopen_handle, symbol); + if (dlerror() == NULL) { IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); - RELEASE_LOCK(&dl_mutex); return v; + } } } - RELEASE_LOCK(&dl_mutex); IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); # define SPECIAL_SYMBOL(sym) \ @@ -722,98 +634,37 @@ internal_dlsym(const char *symbol) { // we failed to find the symbol return NULL; } +# endif -void *lookupSymbolInDLL(void *handle, const char *symbol_name) +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name) { + ACQUIRE_LOCK(&linker_mutex); + #if defined(OBJFORMAT_MACHO) CHECK(symbol_name[0] == '_'); symbol_name = symbol_name+1; #endif - - ACQUIRE_LOCK(&dl_mutex); // dlsym alters dlerror +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) void *result = dlsym(handle, symbol_name); - RELEASE_LOCK(&dl_mutex); +#elif defined(OBJFORMAT_PEi386) + void *result = lookupSymbolInDLL_PEi386(symbol_name, handle, NULL, NULL); +#else + barf("lookupSymbolInNativeObj: Unsupported platform"); +#endif + + RELEASE_LOCK(&linker_mutex); return result; } -# endif -void *addDLL(pathchar* dll_name, const char **errmsg_ptr) +const char *addDLL(pathchar* dll_name) { -# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) - /* ------------------- ELF DLL loader ------------------- */ - -#define NMATCH 5 - regmatch_t match[NMATCH]; - void *handle; - const char *errmsg; - FILE* fp; - size_t match_length; -#define MAXLINE 1000 - char line[MAXLINE]; - int result; - - IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name)); - handle = internal_dlopen(dll_name, &errmsg); - - if (handle != NULL) { - return handle; - } - - // GHC #2615 - // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) - // contain linker scripts rather than ELF-format object code. This - // code handles the situation by recognizing the real object code - // file name given in the linker script. - // - // If an "invalid ELF header" error occurs, it is assumed that the - // .so file contains a linker script instead of ELF object code. - // In this case, the code looks for the GROUP ( ... ) linker - // directive. If one is found, the first file name inside the - // parentheses is treated as the name of a dynamic library and the - // code attempts to dlopen that file. If this is also unsuccessful, - // an error message is returned. - - // see if the error message is due to an invalid ELF header - IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg)); - result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0); - IF_DEBUG(linker, debugBelch("result = %i\n", result)); - if (result == 0) { - // success -- try to read the named file as a linker script - match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), - MAXLINE-1); - strncpy(line, (errmsg+(match[1].rm_so)),match_length); - line[match_length] = '\0'; // make sure string is null-terminated - IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); - if ((fp = __rts_fopen(line, "r")) == NULL) { - *errmsg_ptr = errmsg; // return original error if open fails - return NULL; - } - // try to find a GROUP or INPUT ( ... ) command - while (fgets(line, MAXLINE, fp) != NULL) { - IF_DEBUG(linker, debugBelch("input line = %s", line)); - if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { - // success -- try to dlopen the first named file - IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[2].rm_eo] = '\0'; - stgFree((void*)errmsg); // Free old message before creating new one - handle = internal_dlopen(line+match[2].rm_so, errmsg_ptr); - break; - } - // if control reaches here, no GROUP or INPUT ( ... ) directive - // was found and the original error message is returned to the - // caller - } - fclose(fp); + char *errmsg; + if (loadNativeObj(dll_name, &errmsg)) { + return NULL; + } else { + ASSERT(errmsg != NULL); + return errmsg; } - return handle; - -# elif defined(OBJFORMAT_PEi386) - // FIXME - return addDLL_PEi386(dll_name, NULL); - -# else - barf("addDLL: not implemented on this platform"); -# endif } /* ----------------------------------------------------------------------------- @@ -1240,10 +1091,10 @@ void freeObjectCode (ObjectCode *oc) } if (oc->type == DYNAMIC_OBJECT) { -#if defined(OBJFORMAT_ELF) - ACQUIRE_LOCK(&dl_mutex); - freeNativeCode_ELF(oc); - RELEASE_LOCK(&dl_mutex); +#if defined(OBJFORMAT_ELF) || defined(darwin_HOST_OS) + ACQUIRE_LOCK(&linker_mutex); + freeNativeCode_POSIX(oc); + RELEASE_LOCK(&linker_mutex); #else barf("freeObjectCode: This shouldn't happen"); #endif @@ -1908,12 +1759,20 @@ HsInt purgeObj (pathchar *path) return r; } +ObjectCode *lookupObjectByPath(pathchar *path) { + for (ObjectCode *o = objects; o; o = o->next) { + if (0 == pathcmp(o->fileName, path)) { + return o; + } + } + return NULL; +} + OStatus getObjectLoadStatus_ (pathchar *path) { - for (ObjectCode *o = objects; o; o = o->next) { - if (0 == pathcmp(o->fileName, path)) { - return o->status; - } + ObjectCode *oc = lookupObjectByPath(path); + if (oc) { + return oc->status; } return OBJECT_NOT_LOADED; } @@ -2000,25 +1859,33 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc, #define UNUSED(x) (void)(x) -#if defined(OBJFORMAT_ELF) void * loadNativeObj (pathchar *path, char **errmsg) { + IF_DEBUG(linker, debugBelch("loadNativeObj: path = '%" PATH_FMT "'\n", path)); ACQUIRE_LOCK(&linker_mutex); - void *r = loadNativeObj_ELF(path, errmsg); - RELEASE_LOCK(&linker_mutex); - return r; -} + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + void *r = loadNativeObj_POSIX(path, errmsg); +#elif defined(OBJFORMAT_PEi386) + void *r = NULL; + *errmsg = (char*)addDLL_PEi386(path, (HINSTANCE*)&r); #else -void * STG_NORETURN -loadNativeObj (pathchar *path, char **errmsg) -{ - UNUSED(path); - UNUSED(errmsg); barf("loadNativeObj: not implemented on this platform"); -} #endif -HsInt unloadNativeObj (void *handle) +#if defined(OBJFORMAT_ELF) + if (!r) { + // Check if native object may be a linker script and try loading a native + // object from it + r = loadNativeObjFromLinkerScript_ELF(errmsg); + } +#endif + + RELEASE_LOCK(&linker_mutex); + return r; +} + +static HsInt unloadNativeObj_(void *handle) { bool unloadedAnyObj = false; @@ -2051,11 +1918,18 @@ HsInt unloadNativeObj (void *handle) if (unloadedAnyObj) { return 1; } else { - errorBelch("unloadObjNativeObj_ELF: can't find `%p' to unload", handle); + errorBelch("unloadObjNativeObj_: can't find `%p' to unload", handle); return 0; } } +HsInt unloadNativeObj(void *handle) { + ACQUIRE_LOCK(&linker_mutex); + HsInt r = unloadNativeObj_(handle); + RELEASE_LOCK(&linker_mutex); + return r; +} + /* ----------------------------------------------------------------------------- * Segment management */ ===================================== rts/LinkerInternals.h ===================================== @@ -412,10 +412,6 @@ extern Elf_Word shndx_table_uninit_label; #if defined(THREADED_RTS) extern Mutex linker_mutex; - -#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) -extern Mutex dl_mutex; -#endif #endif /* THREADED_RTS */ /* Type of an initializer */ @@ -515,9 +511,9 @@ HsInt loadArchive_ (pathchar *path); #define USE_CONTIGUOUS_MMAP 0 #endif - HsInt isAlreadyLoaded( pathchar *path ); OStatus getObjectLoadStatus_ (pathchar *path); +ObjectCode *lookupObjectByPath(pathchar *path); HsInt loadOc( ObjectCode* oc ); ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize, bool mapped, pathchar *archiveMemberName, ===================================== rts/RtsSymbols.c ===================================== @@ -509,6 +509,7 @@ extern char **environ; SymI_HasDataProto(stg_block_putmvar) \ MAIN_CAP_SYM \ SymI_HasProto(addDLL) \ + SymI_HasProto(loadNativeObj) \ SymI_HasProto(addLibrarySearchPath) \ SymI_HasProto(removeLibrarySearchPath) \ SymI_HasProto(findSystemLibrary) \ @@ -619,7 +620,7 @@ extern char **environ; SymI_HasProto(purgeObj) \ SymI_HasProto(insertSymbol) \ SymI_HasProto(lookupSymbol) \ - SymI_HasProto(lookupSymbolInDLL) \ + SymI_HasProto(lookupSymbolInNativeObj) \ SymI_HasDataProto(stg_makeStablePtrzh) \ SymI_HasDataProto(stg_mkApUpd0zh) \ SymI_HasDataProto(stg_labelThreadzh) \ ===================================== rts/include/rts/Linker.h ===================================== @@ -90,10 +90,10 @@ void *loadNativeObj( pathchar *path, char **errmsg ); Takes the handle returned from loadNativeObj() as an argument. */ HsInt unloadNativeObj( void *handle ); -/* load a dynamic library */ -void *addDLL(pathchar* dll_name, const char **errmsg); +void *lookupSymbolInNativeObj(void *handle, const char *symbol_name); -void *lookupSymbolInDLL(void *handle, const char *symbol_name); +/* load a dynamic library */ +const char *addDLL(pathchar* dll_name); /* add a path to the library search path */ HsPtr addLibrarySearchPath(pathchar* dll_path); ===================================== rts/linker/Elf.c ===================================== @@ -27,11 +27,15 @@ #include "sm/OSMem.h" #include "linker/util.h" #include "linker/elf_util.h" +#include "linker/LoadNativeObjPosix.h" +#include #include #include #include #include +#include // regex is already used by dlopen() so this is OK + // to use here without requiring an additional lib #if defined(HAVE_DLFCN_H) #include #endif @@ -2069,159 +2073,6 @@ int ocRunFini_ELF( ObjectCode *oc ) return true; } -/* - * Shared object loading - */ - -#if defined(HAVE_DLINFO) -struct piterate_cb_info { - ObjectCode *nc; - void *l_addr; /* base virtual address of the loaded code */ -}; - -static int loadNativeObjCb_(struct dl_phdr_info *info, - size_t _size STG_UNUSED, void *data) { - struct piterate_cb_info *s = (struct piterate_cb_info *) data; - - // This logic mimicks _dl_addr_inside_object from glibc - // For reference: - // int - // internal_function - // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) - // { - // int n = l->l_phnum; - // const ElfW(Addr) reladdr = addr - l->l_addr; - // - // while (--n >= 0) - // if (l->l_phdr[n].p_type == PT_LOAD - // && reladdr - l->l_phdr[n].p_vaddr >= 0 - // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) - // return 1; - // return 0; - // } - - if ((void*) info->dlpi_addr == s->l_addr) { - int n = info->dlpi_phnum; - while (--n >= 0) { - if (info->dlpi_phdr[n].p_type == PT_LOAD) { - NativeCodeRange* ncr = - stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); - ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); - ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); - - ncr->next = s->nc->nc_ranges; - s->nc->nc_ranges = ncr; - } - } - } - return 0; -} -#endif /* defined(HAVE_DLINFO) */ - -static void copyErrmsg(char** errmsg_dest, char* errmsg) { - if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error"; - *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF"); - strcpy(*errmsg_dest, errmsg); -} - -// need dl_mutex -void freeNativeCode_ELF (ObjectCode *nc) { - dlclose(nc->dlopen_handle); - - NativeCodeRange *ncr = nc->nc_ranges; - while (ncr) { - NativeCodeRange* last_ncr = ncr; - ncr = ncr->next; - stgFree(last_ncr); - } -} - -void * loadNativeObj_ELF (pathchar *path, char **errmsg) -{ - ObjectCode* nc; - void *hdl, *retval; - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path)); - - retval = NULL; - ACQUIRE_LOCK(&dl_mutex); - - /* Loading the same object multiple times will lead to chaos - * as we will have two ObjectCodes but one underlying dlopen - * handle. Fail if this happens. - */ - if (getObjectLoadStatus_(path) != OBJECT_NOT_LOADED) { - copyErrmsg(errmsg, "loadNativeObj_ELF: Already loaded"); - goto dlopen_fail; - } - - nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); - - foreignExportsLoadingObject(nc); - hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL); - nc->dlopen_handle = hdl; - foreignExportsFinishedLoadingObject(); - if (hdl == NULL) { - /* dlopen failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlopen_fail; - } - -#if defined(HAVE_DLINFO) - struct link_map *map; - if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { - /* dlinfo failed; save the message in errmsg */ - copyErrmsg(errmsg, dlerror()); - goto dlinfo_fail; - } - - hdl = NULL; // pass handle ownership to nc - - struct piterate_cb_info piterate_info = { - .nc = nc, - .l_addr = (void *) map->l_addr - }; - dl_iterate_phdr(loadNativeObjCb_, &piterate_info); - if (!nc->nc_ranges) { - copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); - goto dl_iterate_phdr_fail; - } - nc->unloadable = true; -#else - nc->nc_ranges = NULL; - nc->unloadable = false; -#endif /* defined (HAVE_DLINFO) */ - - insertOCSectionIndices(nc); - - nc->next_loaded_object = loaded_objects; - loaded_objects = nc; - - retval = nc->dlopen_handle; - -#if defined(PROFILING) - // collect any new cost centres that were defined in the loaded object. - refreshProfilingCCSs(); -#endif - - goto success; - -dl_iterate_phdr_fail: - // already have dl_mutex - freeNativeCode_ELF(nc); -dlinfo_fail: - if (hdl) dlclose(hdl); -dlopen_fail: -success: - - RELEASE_LOCK(&dl_mutex); - - IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval)); - - return retval; -} - - /* * PowerPC & X86_64 ELF specifics */ @@ -2271,4 +2122,71 @@ int ocAllocateExtras_ELF( ObjectCode *oc ) #endif /* NEED_SYMBOL_EXTRAS */ +extern regex_t re_invalid; +extern regex_t re_realso; + +void * loadNativeObjFromLinkerScript_ELF(char **errmsg) +{ + // GHC #2615 + // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so) + // contain linker scripts rather than ELF-format object code. This + // code handles the situation by recognizing the real object code + // file name given in the linker script. + // + // If an "invalid ELF header" error occurs, it is assumed that the + // .so file contains a linker script instead of ELF object code. + // In this case, the code looks for the GROUP ( ... ) linker + // directive. If one is found, the first file name inside the + // parentheses is treated as the name of a dynamic library and the + // code attempts to dlopen that file. If this is also unsuccessful, + // an error message is returned. + +#define NMATCH 5 + regmatch_t match[NMATCH]; + FILE* fp; + size_t match_length; +#define MAXLINE 1000 + char line[MAXLINE]; + int result; + void* r = NULL; + + ASSERT_LOCK_HELD(&linker_mutex); + + // see if the error message is due to an invalid ELF header + IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", *errmsg)); + result = regexec(&re_invalid, *errmsg, (size_t) NMATCH, match, 0); + IF_DEBUG(linker, debugBelch("result = %i\n", result)); + if (result == 0) { + // success -- try to read the named file as a linker script + match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so), + MAXLINE-1); + strncpy(line, (*errmsg+(match[1].rm_so)),match_length); + line[match_length] = '\0'; // make sure string is null-terminated + IF_DEBUG(linker, debugBelch("file name = '%s'\n", line)); + if ((fp = __rts_fopen(line, "r")) == NULL) { + // return original error if open fails + return NULL; + } + // try to find a GROUP or INPUT ( ... ) command + while (fgets(line, MAXLINE, fp) != NULL) { + IF_DEBUG(linker, debugBelch("input line = %s", line)); + if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { + // success -- try to dlopen the first named file + IF_DEBUG(linker, debugBelch("match%s\n","")); + line[match[2].rm_eo] = '\0'; + stgFree((void*)*errmsg); // Free old message before creating new one + r = loadNativeObj_POSIX(line+match[2].rm_so, errmsg); + break; + } + // if control reaches here, no GROUP or INPUT ( ... ) directive + // was found and the original error message is returned to the + // caller + } + fclose(fp); + } + + return r; +} + + #endif /* elf */ ===================================== rts/linker/Elf.h ===================================== @@ -14,7 +14,6 @@ int ocResolve_ELF ( ObjectCode* oc ); int ocRunInit_ELF ( ObjectCode* oc ); int ocRunFini_ELF ( ObjectCode* oc ); int ocAllocateExtras_ELF ( ObjectCode *oc ); -void freeNativeCode_ELF ( ObjectCode *nc ); -void *loadNativeObj_ELF ( pathchar *path, char **errmsg ); +void *loadNativeObjFromLinkerScript_ELF( char **errmsg ); #include "EndPrivate.h" ===================================== rts/linker/LoadNativeObjPosix.c ===================================== @@ -0,0 +1,214 @@ +#include "LinkerInternals.h" +#include "Rts.h" + +#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO) + +#include "CheckUnload.h" +#include "ForeignExports.h" +#include "RtsUtils.h" +#include "Profiling.h" + +#include "linker/LoadNativeObjPosix.h" + +#if defined(HAVE_DLFCN_H) +#include +#endif + +#if defined(HAVE_DLINFO) +#include +#endif + +#include + +/* + * Shared object loading + */ + +#if defined(HAVE_DLINFO) +struct piterate_cb_info { + ObjectCode *nc; + void *l_addr; /* base virtual address of the loaded code */ +}; + +static int loadNativeObjCb_(struct dl_phdr_info *info, + size_t _size STG_UNUSED, void *data) { + struct piterate_cb_info *s = (struct piterate_cb_info *) data; + + // This logic mimicks _dl_addr_inside_object from glibc + // For reference: + // int + // internal_function + // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr) + // { + // int n = l->l_phnum; + // const ElfW(Addr) reladdr = addr - l->l_addr; + // + // while (--n >= 0) + // if (l->l_phdr[n].p_type == PT_LOAD + // && reladdr - l->l_phdr[n].p_vaddr >= 0 + // && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz) + // return 1; + // return 0; + // } + + if ((void*) info->dlpi_addr == s->l_addr) { + int n = info->dlpi_phnum; + while (--n >= 0) { + if (info->dlpi_phdr[n].p_type == PT_LOAD) { + NativeCodeRange* ncr = + stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_"); + ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr); + ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz); + + ncr->next = s->nc->nc_ranges; + s->nc->nc_ranges = ncr; + } + } + } + return 0; +} +#endif /* defined(HAVE_DLINFO) */ + +static void copyErrmsg(char** errmsg_dest, char* errmsg) { + if (errmsg == NULL) errmsg = "loadNativeObj_POSIX: unknown error"; + *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_POSIX"); + strcpy(*errmsg_dest, errmsg); +} + +void freeNativeCode_POSIX (ObjectCode *nc) { + ASSERT_LOCK_HELD(&linker_mutex); + + dlclose(nc->dlopen_handle); + + NativeCodeRange *ncr = nc->nc_ranges; + while (ncr) { + NativeCodeRange* last_ncr = ncr; + ncr = ncr->next; + stgFree(last_ncr); + } +} + +void * loadNativeObj_POSIX (pathchar *path, char **errmsg) +{ + ObjectCode* nc; + void *hdl, *retval; + + ASSERT_LOCK_HELD(&linker_mutex); + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX %" PATH_FMT "\n", path)); + + retval = NULL; + + + /* If we load the same object multiple times, just return the + * already-loaded handle. Note that this is broken if unloadNativeObj + * is used, as we don’t do any reference counting; see #24345. + */ + ObjectCode *existing_oc = lookupObjectByPath(path); + if (existing_oc && existing_oc->status != OBJECT_UNLOADED) { + if (existing_oc->type == DYNAMIC_OBJECT) { + retval = existing_oc->dlopen_handle; + goto success; + } + copyErrmsg(errmsg, "loadNativeObj_POSIX: already loaded as non-dynamic object"); + goto dlopen_fail; + } + + nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0); + + foreignExportsLoadingObject(nc); + + // When dlopen() loads a profiled dynamic library, it calls the ctors which + // will call registerCcsList() to append the defined CostCentreStacks to + // CCS_LIST. However, another thread may be doing other things with the RTS + // linker that transitively calls refreshProfilingCCSs() which also accesses + // CCS_LIST. So there's a risk of data race that may lead to segfaults + // (#24423), and we need to ensure the ctors are also protected by + // ccs_mutex. +#if defined(PROFILING) + ACQUIRE_LOCK(&ccs_mutex); +#endif + + // If we HAVE_DLINFO, we use RTLD_NOW rather than RTLD_LAZY because we want + // to learn eagerly about all external functions. Otherwise, there is no + // additional advantage to being eager, so it is better to be lazy and only bind + // functions when needed for better performance. + int dlopen_mode; +#if defined(HAVE_DLINFO) + dlopen_mode = RTLD_NOW; +#else + dlopen_mode = RTLD_LAZY; +#endif + + hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + nc->dlopen_handle = hdl; + nc->status = OBJECT_READY; + +#if defined(PROFILING) + RELEASE_LOCK(&ccs_mutex); +#endif + + foreignExportsFinishedLoadingObject(); + + if (hdl == NULL) { + /* dlopen failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlopen_fail; + } + +#if defined(HAVE_DLINFO) + struct link_map *map; + if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) { + /* dlinfo failed; save the message in errmsg */ + copyErrmsg(errmsg, dlerror()); + goto dlinfo_fail; + } + + hdl = NULL; // pass handle ownership to nc + + struct piterate_cb_info piterate_info = { + .nc = nc, + .l_addr = (void *) map->l_addr + }; + dl_iterate_phdr(loadNativeObjCb_, &piterate_info); + if (!nc->nc_ranges) { + copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj"); + goto dl_iterate_phdr_fail; + } + nc->unloadable = true; +#else + nc->nc_ranges = NULL; + nc->unloadable = false; +#endif /* defined (HAVE_DLINFO) */ + + insertOCSectionIndices(nc); + + nc->next_loaded_object = loaded_objects; + loaded_objects = nc; + + retval = nc->dlopen_handle; + +#if defined(PROFILING) + // collect any new cost centres that were defined in the loaded object. + refreshProfilingCCSs(); +#endif + + goto success; + +#if defined(HAVE_DLINFO) +dl_iterate_phdr_fail: +#endif + freeNativeCode_POSIX(nc); +#if defined(HAVE_DLINFO) +dlinfo_fail: +#endif + if (hdl) dlclose(hdl); +dlopen_fail: +success: + + IF_DEBUG(linker, debugBelch("loadNativeObj_POSIX result=%p\n", retval)); + + return retval; +} + +#endif /* elf + macho */ ===================================== rts/linker/LoadNativeObjPosix.h ===================================== @@ -0,0 +1,11 @@ +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void freeNativeCode_POSIX ( ObjectCode *nc ); +void *loadNativeObj_POSIX ( pathchar *path, char **errmsg ); + +#include "EndPrivate.h" ===================================== rts/linker/PEi386.c ===================================== @@ -1017,7 +1017,10 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f stgFree(dllName); IF_DEBUG(linker, debugBelch("loadArchive: read symbol %s from lib `%" PATH_FMT "'\n", symbol, dll)); - const char* result = addDLL(dll); + // We must call `addDLL_PEi386` directly rather than `addDLL` because `addDLL` + // is now a wrapper around `loadNativeObj` which acquires a lock which we + // already have here. + const char* result = addDLL_PEi386(dll, NULL); stgFree(image); @@ -1141,47 +1144,57 @@ SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl, ObjectCode *dependent ) { OpenedDLL* o_dll; - SymbolAddr* sym; + SymbolAddr* res; - for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ + for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) + if ((res = lookupSymbolInDLL_PEi386(lbl, o_dll->instance, o_dll->name, dependent))) + return res; + return NULL; +} - sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ - return sym; - } +SymbolAddr* +lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name STG_UNUSED, ObjectCode *dependent) +{ + SymbolAddr* sym; - // TODO: Drop this - /* Ticket #2283. - Long description: http://support.microsoft.com/kb/132044 - tl;dr: - If C/C++ compiler sees __declspec(dllimport) ... foo ... - it generates call *__imp_foo, and __imp_foo here has exactly - the same semantics as in __imp_foo = GetProcAddress(..., "foo") - */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { - sym = GetProcAddress(o_dll->instance, - lbl + 6 + STRIP_LEADING_UNDERSCORE); - if (sym != NULL) { - SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); - if (indirect == NULL) { - barf("lookupSymbolInDLLs: Failed to allocation indirection"); - } - *indirect = sym; - IF_DEBUG(linker, - debugBelch("warning: %s from %S is linked instead of %s\n", - lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); - return (void*) indirect; - } - } + /* debugBelch("look in %ls for %s\n", dll_name, lbl); */ - sym = GetProcAddress(o_dll->instance, lbl); + sym = GetProcAddress(instance, lbl+STRIP_LEADING_UNDERSCORE); + if (sym != NULL) { + /*debugBelch("found %s in %ls\n", lbl+STRIP_LEADING_UNDERSCORE,dll_name);*/ + return sym; + } + + // TODO: Drop this + /* Ticket #2283. + Long description: http://support.microsoft.com/kb/132044 + tl;dr: + If C/C++ compiler sees __declspec(dllimport) ... foo ... + it generates call *__imp_foo, and __imp_foo here has exactly + the same semantics as in __imp_foo = GetProcAddress(..., "foo") + */ + if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + sym = GetProcAddress(instance, + lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ - return sym; + SymbolAddr** indirect = m32_alloc(dependent->rw_m32, sizeof(SymbolAddr*), 8); + if (indirect == NULL) { + barf("lookupSymbolInDLLs: Failed to allocation indirection"); + } + *indirect = sym; + IF_DEBUG(linker, + debugBelch("warning: %s from %S is linked instead of %s\n", + lbl+6+STRIP_LEADING_UNDERSCORE, dll_name, lbl)); + return (void*) indirect; } } + + sym = GetProcAddress(instance, lbl); + if (sym != NULL) { + /*debugBelch("found %s in %s\n", lbl,dll_name);*/ + return sym; + } + return NULL; } ===================================== rts/linker/PEi386.h ===================================== @@ -60,6 +60,7 @@ bool ocRunFini_PEi386 ( ObjectCode *oc ); bool ocGetNames_PEi386 ( ObjectCode* oc ); bool ocVerifyImage_PEi386 ( ObjectCode* oc ); SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type); +SymbolAddr *lookupSymbolInDLL_PEi386 (const SymbolName* lbl, HINSTANCE instance, pathchar* dll_name, ObjectCode *dependent); /* See Note [mingw-w64 name decoration scheme] */ /* We use myindex to calculate array addresses, rather than ===================================== rts/rts.cabal ===================================== @@ -458,6 +458,7 @@ library linker/Elf.c linker/InitFini.c linker/LoadArchive.c + linker/LoadNativeObjPosix.c linker/M32Alloc.c linker/MMap.c linker/MachO.c ===================================== testsuite/tests/ghci/linking/dyn/T3372.hs ===================================== @@ -1,3 +1,6 @@ +-- Note: This test exercises running concurrent GHCi sessions, but +-- although this test is expected to pass, running concurrent GHCi +-- sessions is currently broken in other ways; see #24345. {-# LANGUAGE MagicHash #-} module Main where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/39e5cb6c7092073f18a6442fac858d1a0fc70fdf...83e7e694278980c08874a66dd9d35330619c300d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/39e5cb6c7092073f18a6442fac858d1a0fc70fdf...83e7e694278980c08874a66dd9d35330619c300d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 18:12:56 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 Apr 2024 14:12:56 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: testsuite: Introduce template-haskell-exports test Message-ID: <660d9c281c43f_231e181a007347862f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b7265197 by Ben Gamari at 2024-04-03T14:12:46-04:00 testsuite: Introduce template-haskell-exports test - - - - - addae194 by Luite Stegeman at 2024-04-03T14:12:50-04:00 Update correct counter in bumpTickyAllocd - - - - - c0df4506 by Andrei Borzenkov at 2024-04-03T14:12:51-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Tc/Deriv/Functor.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 - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a5f45a7f00c7686d9f01075295370d205a6ad84c...c0df45068a1e8495280ab7ed09615c8f516902e3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a5f45a7f00c7686d9f01075295370d205a6ad84c...c0df45068a1e8495280ab7ed09615c8f516902e3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 20:52:13 2024 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 03 Apr 2024 16:52:13 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/epa-cimport-epalocated Message-ID: <660dc17d53141_254dae107988c37038@gitlab.mail> Alan Zimmerman pushed new branch wip/az/epa-cimport-epalocated at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-cimport-epalocated You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 21:33:23 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 Apr 2024 17:33:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: testsuite: Introduce template-haskell-exports test Message-ID: <660dcb2368f0f_254dae17811ac47312@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ab79ec98 by Ben Gamari at 2024-04-03T17:33:12-04:00 testsuite: Introduce template-haskell-exports test - - - - - cf0612c6 by Luite Stegeman at 2024-04-03T17:33:15-04:00 Update correct counter in bumpTickyAllocd - - - - - 423b2705 by Andrei Borzenkov at 2024-04-03T17:33:16-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Tc/Deriv/Functor.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 - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0df45068a1e8495280ab7ed09615c8f516902e3...423b2705cf189dffa1c8073d0febe7fe86bc2f8f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0df45068a1e8495280ab7ed09615c8f516902e3...423b2705cf189dffa1c8073d0febe7fe86bc2f8f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Apr 3 21:50:23 2024 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 03 Apr 2024 17:50:23 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] testsuite: Add test for lookupSymbolInNativeObj Message-ID: <660dcf1fdd732_254dae1a21c40538cb@gitlab.mail> Ben Gamari pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 00f908b0 by Ben Gamari at 2024-04-03T17:41:37-04:00 testsuite: Add test for lookupSymbolInNativeObj - - - - - 5 changed files: - + testsuite/tests/rts/linker/lookupSymbolInNativeObj/Makefile - + testsuite/tests/rts/linker/lookupSymbolInNativeObj/all.T - + testsuite/tests/rts/linker/lookupSymbolInNativeObj/lookupSymbolInNativeObj1.c - + testsuite/tests/rts/linker/lookupSymbolInNativeObj/lookupSymbolInNativeObj1.stdout - + testsuite/tests/rts/linker/lookupSymbolInNativeObj/obj.c Changes: ===================================== testsuite/tests/rts/linker/lookupSymbolInNativeObj/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +lookupSymbolInNativeObj1: + '$(TEST_HC)' -shared -dynamic obj.c -o libobj.so + '$(TEST_HC)' -no-hs-main -dynamic lookupSymbolInNativeObj1.c -o main + ./main + ===================================== testsuite/tests/rts/linker/lookupSymbolInNativeObj/all.T ===================================== @@ -0,0 +1,5 @@ +test('lookupSymbolInNativeObj1', + [unless(have_dynamic(), skip), + extra_files(['obj.c'])], + makefile_test, []) + ===================================== testsuite/tests/rts/linker/lookupSymbolInNativeObj/lookupSymbolInNativeObj1.c ===================================== @@ -0,0 +1,39 @@ +#include "Rts.h" + +#if defined(mingw32_HOST_OS) +#define PATH_STR(str) L##str +#else +#define PATH_STR(str) str +#endif + +typedef void (*hello_t)(); + +int main(int argc, char *argv[]) +{ + RtsConfig conf = defaultRtsConfig; + conf.rts_opts_enabled = RtsOptsAll; + hs_init_ghc(&argc, &argv, conf); + + initLinker_(0); + + int ok; + char *errmsg; + void *obj = loadNativeObj("./libobj.so", &errmsg); + if (!obj) { + barf("loadNativeObj failed: %s", errmsg); + } + + hello_t sym; + sym = lookupSymbolInNativeObj(obj, "hello"); + if (sym == NULL) { + barf("lookupSymbolInNativeObj failed unexpectedly"); + } + sym(); + + sym = lookupSymbolInNativeObj(obj, "hello_world"); + if (sym != NULL) { + barf("lookupSymbolInNativeObj succeeded unexpectedly"); + } + + return 0; +} ===================================== testsuite/tests/rts/linker/lookupSymbolInNativeObj/lookupSymbolInNativeObj1.stdout ===================================== @@ -0,0 +1 @@ +hello world ===================================== testsuite/tests/rts/linker/lookupSymbolInNativeObj/obj.c ===================================== @@ -0,0 +1,5 @@ +#include + +void hello() { + printf("hello world\n"); +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00f908b07ae52b0ecfea90eb708a309da0257abe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00f908b07ae52b0ecfea90eb708a309da0257abe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 00:43:42 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 Apr 2024 20:43:42 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: testsuite: Introduce template-haskell-exports test Message-ID: <660df7be77b12_254dae2f40d886164a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e7f51b12 by Ben Gamari at 2024-04-03T20:43:34-04:00 testsuite: Introduce template-haskell-exports test - - - - - b65a7f78 by Luite Stegeman at 2024-04-03T20:43:37-04:00 Update correct counter in bumpTickyAllocd - - - - - 7f6ff03e by Andrei Borzenkov at 2024-04-03T20:43:38-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Tc/Deriv/Functor.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 - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/423b2705cf189dffa1c8073d0febe7fe86bc2f8f...7f6ff03e1b53ec6d93e40d63f7f3e7bd9ae05434 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/423b2705cf189dffa1c8073d0febe7fe86bc2f8f...7f6ff03e1b53ec6d93e40d63f7f3e7bd9ae05434 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 05:04:40 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 01:04:40 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: testsuite: Introduce template-haskell-exports test Message-ID: <660e34e7f289d_312ac81b1cff040464@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 481af81a by Ben Gamari at 2024-04-04T01:04:26-04:00 testsuite: Introduce template-haskell-exports test - - - - - ff592218 by Luite Stegeman at 2024-04-04T01:04:30-04:00 Update correct counter in bumpTickyAllocd - - - - - 1b70a89e by Andrei Borzenkov at 2024-04-04T01:04:31-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Tc/Deriv/Functor.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 - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f6ff03e1b53ec6d93e40d63f7f3e7bd9ae05434...1b70a89eca6fcab897a5d270a0158847eda1f997 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f6ff03e1b53ec6d93e40d63f7f3e7bd9ae05434...1b70a89eca6fcab897a5d270a0158847eda1f997 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 08:04:58 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 04:04:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: testsuite: Introduce template-haskell-exports test Message-ID: <660e5f2abc48e_235424109e3d011811a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 870bb024 by Ben Gamari at 2024-04-04T04:04:50-04:00 testsuite: Introduce template-haskell-exports test - - - - - 329380e7 by Luite Stegeman at 2024-04-04T04:04:53-04:00 Update correct counter in bumpTickyAllocd - - - - - 3 changed files: - compiler/GHC/StgToCmm/Ticky.hs - testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/template-haskell-exports.stdout Changes: ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -809,7 +809,7 @@ bumpTickyEntryCount lbl = do bumpTickyAllocd :: CLabel -> Int -> FCode () bumpTickyAllocd lbl bytes = do platform <- getPlatform - bumpTickyLitBy (cmmLabelOffB lbl (pc_OFFSET_StgEntCounter_entry_count (platformConstants platform))) bytes + bumpTickyLitBy (cmmLabelOffB lbl (pc_OFFSET_StgEntCounter_allocd (platformConstants platform))) bytes bumpTickyTagSkip :: CLabel -> FCode () bumpTickyTagSkip lbl = do ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -9,3 +9,4 @@ def check_package(pkg_name): check_package('base') check_package('ghc-experimental') +check_package('template-haskell') ===================================== testsuite/tests/interface-stability/template-haskell-exports.stdout ===================================== The diff for this file was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b70a89eca6fcab897a5d270a0158847eda1f997...329380e731bc3d455cc64f0c5a1f2463c39c11cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b70a89eca6fcab897a5d270a0158847eda1f997...329380e731bc3d455cc64f0c5a1f2463c39c11cb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 08:07:30 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 04 Apr 2024 04:07:30 -0400 Subject: [Git][ghc/ghc][wip/T23109] Wibble imports Message-ID: <660e5fc2681f4_23542411e6cb012311c@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: 53437d46 by Simon Peyton Jones at 2024-04-04T09:07:01+01:00 Wibble imports - - - - - 1 changed file: - compiler/GHC/Core/Unfold.hs Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -41,6 +41,8 @@ import GHC.Core import GHC.Core.Utils import GHC.Core.DataCon import GHC.Core.Type +import GHC.Core.Class( Class, classTyCon ) +import GHC.Core.TyCon( isNewTyCon ) import GHC.Types.Id import GHC.Types.Literal View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53437d46bb7fd3790bc06814e70d893f2c5a9454 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53437d46bb7fd3790bc06814e70d893f2c5a9454 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 09:38:54 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Thu, 04 Apr 2024 05:38:54 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] Make template-haskell a stage1 package Message-ID: <660e752e18000_15494c8d423080176@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: 7dcc34c9 by Teo Camarasu at 2024-04-04T10:36:52+01:00 Make template-haskell a stage1 package Promoting template-haskell from a stage0 to a stage1 package means that we can much more easily refactor template-haskell. In order to accomplish this we now compile stage0 packages using the boot compiler's version of template-haskell. This means that there are now two versions of template-haskell in play: the boot compiler's version, and the in-tree version. When compiling the stage1 compiler, we have to pick a version of template-haskell to use. During bootstrapping we want to use the same version as the final compiler. This forces the in-tree version. We are only able to use the internal interpreter with stage2 onwards. Yet, we could still use the external interpreter. The external interpreter runs splices in another process. Queries and results are seralised. This reduces our compatibility requirements from ABI compatibility with the internal interpreter to mere serialisation compatibility. We may compile GHC against another library to what the external interpreter is compiled against so long as it has exactly the same serialisation of template-haskell types. This opens up the strategy pursued in this patch. When compiling the stage1 compiler we vendor the template-haskell and ghc-boot-th libraries through ghc-boot and use these to define the Template Haskell interface for the external interpreter. Note that at this point we also have the template-haskell and ghc-boot-th packages in our transitive dependency closure from the boot compiler, and some packages like containers have dependencies on these to define Lift instances. Then the external interpreter should be compiled against the regular template-haskell library from the source tree. As this will have the same serialised interface as what we vendor in ghc-boot, we can then run splices. GHC stage2 is compiled as normal as well against the template-haskell library from the source tree. Resolves #23536 - - - - - 10 changed files: - compiler/ghc.cabal.in - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -115,7 +115,6 @@ Library containers >= 0.6.2.1 && < 0.8, array >= 0.1 && < 0.6, filepath >= 1 && < 1.6, - template-haskell == 2.22.*, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -35,7 +35,10 @@ extra_dependencies = where th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") - dep (p1, m1) (p2, m2) s = do + dep (p1, m1) (p2, m2) s = + -- We use the boot compiler's `template-haskell` library when building stage0, + -- so we don't need to register dependencies. + if isStage0 s then pure [] else do let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set") ways <- interpretInContext context getLibraryWays mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways) ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,7 +158,6 @@ toolTargets = [ binary -- , ghc -- # depends on ghc library -- , runGhc -- # depends on ghc library , ghcBoot - , ghcBootTh , ghcPlatform , ghcToolchain , ghcToolchainBin @@ -172,7 +171,6 @@ toolTargets = [ binary , mtl , parsec , time - , templateHaskell , text , transformers , semaphoreCompat ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -93,7 +93,6 @@ stage0Packages = do , ghc , runGhc , ghcBoot - , ghcBootTh , ghcPlatform , ghcHeap , ghcToolchain @@ -108,7 +107,6 @@ stage0Packages = do , parsec , semaphoreCompat , time - , templateHaskell , text , transformers , unlit @@ -143,6 +141,7 @@ stage1Packages = do , deepseq , exceptions , ghc + , ghcBootTh , ghcBignum , ghcCompact , ghcExperimental @@ -156,6 +155,7 @@ stage1Packages = do , pretty , rts , semaphoreCompat + , templateHaskell , stm , unlit , xhtml ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -121,6 +121,10 @@ packageArgs = do , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ? input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ] + -------------------------------- ghcBoot ------------------------------ + , package ghcBoot ? + builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap-th") + --------------------------------- ghci --------------------------------- , package ghci ? mconcat [ ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -35,6 +35,11 @@ source-repository head location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/ghc-boot +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + Library default-language: Haskell2010 other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables @@ -56,13 +61,6 @@ Library GHC.UniqueSubdir GHC.Version - -- reexport modules from ghc-boot-th so that packages don't have to import - -- both ghc-boot and ghc-boot-th. It makes the dependency graph easier to - -- understand and to refactor. - reexported-modules: - GHC.LanguageExtensions.Type - , GHC.ForeignSrcLang.Type - , GHC.Lexeme -- reexport platform modules from ghc-platform reexported-modules: @@ -81,7 +79,49 @@ Library filepath >= 1.3 && < 1.6, deepseq >= 1.4 && < 1.6, ghc-platform >= 0.1, - ghc-boot-th == @ProjectVersionMunged@ + if flag(bootstrap-th) + cpp-options: -DBOOTSTRAP_TH + build-depends: + ghc-prim + , pretty + -- we vendor ghc-boot-th and template-haskell while bootstrapping TH. + -- This is to avoid having two copies of ghc-boot-th and template-haskell + -- in the build graph: one from the boot compiler and the in-tree one. + hs-source-dirs: . ../ghc-boot-th ../template-haskell ../template-haskell/vendored-filepath + exposed-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Lib + , Language.Haskell.TH.Ppr + , Language.Haskell.TH.PprLib + , Language.Haskell.TH.Quote + , Language.Haskell.TH.Syntax + , Language.Haskell.TH.LanguageExtensions + , Language.Haskell.TH.CodeDo + , Language.Haskell.TH.Lib.Internal + + other-modules: + Language.Haskell.TH.Lib.Map + , System.FilePath + , System.FilePath.Posix + , System.FilePath.Windows + else + hs-source-dirs: . + build-depends: + ghc-boot-th == @ProjectVersionMunged@ + , template-haskell == 2.22.0.0 + -- reexport modules from ghc-boot-th and template-haskell so that packages + -- don't have to import all of ghc-boot, ghc-boot-th and template-haskell. + -- It makes the dependency graph easier to understand and to refactor + -- and reduces the amount of cabal flags we need to use for bootstrapping TH. + reexported-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Syntax if !os(windows) build-depends: unix >= 2.7 && < 2.9 ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -84,7 +84,6 @@ library filepath >= 1.4 && < 1.6, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, - template-haskell == 2.22.*, transformers >= 0.5 && < 0.7 if !os(windows) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -34,13 +34,12 @@ module Language.Haskell.TH.Syntax -- $infix ) where -import qualified Data.Fixed as Fixed +import Prelude import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import System.FilePath import GHC.IO.Unsafe ( unsafeDupableInterleaveIO ) -import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Fix (MonadFix (..)) import Control.Applicative (Applicative(..)) @@ -48,35 +47,42 @@ import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO) import Control.Exception.Base (FixIOException (..)) import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar) import System.IO ( hPutStrLn, stderr ) -import Data.Char ( isAlpha, isAlphaNum, isUpper, ord ) +import Data.Char ( isAlpha, isAlphaNum, isUpper ) import Data.Int import Data.List.NonEmpty ( NonEmpty(..) ) -import Data.Void ( Void, absurd ) import Data.Word import Data.Ratio -import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) -import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), - TYPE, RuntimeRep(..), Levity(..), 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 ) import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions -import Numeric.Natural import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types +#ifdef BOOTSTRAP_TH +import GHC.Types (TYPE, RuntimeRep(..), Levity(..)) +#else +import Control.Monad (liftM) +import Data.Char (ord) +import qualified Data.Fixed as Fixed +import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) +import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), + TYPE, RuntimeRep(..), Levity(..) ) +import GHC.CString ( unpackCString# ) +import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) +import Data.Void ( Void, absurd ) +import Numeric.Natural import Data.Array.Byte (ByteArray(..)) import GHC.Exts ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray# , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents# , copyByteArray#, newPinnedByteArray#) -import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) import GHC.ST (ST(..), runST) +#endif ----------------------------------------------------- -- @@ -1018,6 +1024,7 @@ class Lift (t :: TYPE r) where liftTyped :: Quote m => t -> Code m t +#ifndef BOOTSTRAP_TH -- If you add any instances here, consider updating test th/TH_Lift instance Lift Integer where liftTyped x = unsafeCodeCoerce (lift x) @@ -1384,10 +1391,11 @@ rightName = 'Right nonemptyName :: Name nonemptyName = '(:|) +#endif oneName, manyName :: Name -oneName = 'One -manyName = 'Many +oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" +manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" ----------------------------------------------------- -- ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Posix ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Windows ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7dcc34c94995393a733af9e6294ded327d1a10a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7dcc34c94995393a733af9e6294ded327d1a10a7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 09:41:29 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Thu, 04 Apr 2024 05:41:29 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] Make template-haskell a stage1 package Message-ID: <660e75c9401a2_15494ca366b4902a3@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: af633d6c by Teo Camarasu at 2024-04-04T10:41:14+01:00 Make template-haskell a stage1 package Promoting template-haskell from a stage0 to a stage1 package means that we can much more easily refactor template-haskell. In order to accomplish this we now compile stage0 packages using the boot compiler's version of template-haskell. This means that there are now two versions of template-haskell in play: the boot compiler's version, and the in-tree version. When compiling the stage1 compiler, we have to pick a version of template-haskell to use. During bootstrapping we want to use the same version as the final compiler. This forces the in-tree version. We are only able to use the internal interpreter with stage2 onwards. Yet, we could still use the external interpreter. The external interpreter runs splices in another process. Queries and results are seralised. This reduces our compatibility requirements from ABI compatibility with the internal interpreter to mere serialisation compatibility. We may compile GHC against another library to what the external interpreter is compiled against so long as it has exactly the same serialisation of template-haskell types. This opens up the strategy pursued in this patch. When compiling the stage1 compiler we vendor the template-haskell and ghc-boot-th libraries through ghc-boot and use these to define the Template Haskell interface for the external interpreter. Note that at this point we also have the template-haskell and ghc-boot-th packages in our transitive dependency closure from the boot compiler, and some packages like containers have dependencies on these to define Lift instances. Then the external interpreter should be compiled against the regular template-haskell library from the source tree. As this will have the same serialised interface as what we vendor in ghc-boot, we can then run splices. GHC stage2 is compiled as normal as well against the template-haskell library from the source tree. Resolves #23536 - - - - - 10 changed files: - compiler/ghc.cabal.in - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -115,7 +115,6 @@ Library containers >= 0.6.2.1 && < 0.8, array >= 0.1 && < 0.6, filepath >= 1 && < 1.6, - template-haskell == 2.22.*, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -35,7 +35,10 @@ extra_dependencies = where th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") - dep (p1, m1) (p2, m2) s = do + dep (p1, m1) (p2, m2) s = + -- We use the boot compiler's `template-haskell` library when building stage0, + -- so we don't need to register dependencies. + if isStage0 s then pure [] else do let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set") ways <- interpretInContext context getLibraryWays mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways) ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,7 +158,6 @@ toolTargets = [ binary -- , ghc -- # depends on ghc library -- , runGhc -- # depends on ghc library , ghcBoot - , ghcBootTh , ghcPlatform , ghcToolchain , ghcToolchainBin @@ -172,7 +171,6 @@ toolTargets = [ binary , mtl , parsec , time - , templateHaskell , text , transformers , semaphoreCompat ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -93,7 +93,6 @@ stage0Packages = do , ghc , runGhc , ghcBoot - , ghcBootTh , ghcPlatform , ghcHeap , ghcToolchain @@ -108,7 +107,6 @@ stage0Packages = do , parsec , semaphoreCompat , time - , templateHaskell , text , transformers , unlit @@ -143,6 +141,7 @@ stage1Packages = do , deepseq , exceptions , ghc + , ghcBootTh , ghcBignum , ghcCompact , ghcExperimental @@ -156,6 +155,7 @@ stage1Packages = do , pretty , rts , semaphoreCompat + , templateHaskell , stm , unlit , xhtml ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -121,6 +121,10 @@ packageArgs = do , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ? input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ] + -------------------------------- ghcBoot ------------------------------ + , package ghcBoot ? + builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap-th") + --------------------------------- ghci --------------------------------- , package ghci ? mconcat [ ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -35,6 +35,11 @@ source-repository head location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/ghc-boot +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + Library default-language: Haskell2010 other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables @@ -56,13 +61,6 @@ Library GHC.UniqueSubdir GHC.Version - -- reexport modules from ghc-boot-th so that packages don't have to import - -- both ghc-boot and ghc-boot-th. It makes the dependency graph easier to - -- understand and to refactor. - reexported-modules: - GHC.LanguageExtensions.Type - , GHC.ForeignSrcLang.Type - , GHC.Lexeme -- reexport platform modules from ghc-platform reexported-modules: @@ -81,7 +79,49 @@ Library filepath >= 1.3 && < 1.6, deepseq >= 1.4 && < 1.6, ghc-platform >= 0.1, - ghc-boot-th == @ProjectVersionMunged@ + if flag(bootstrap-th) + cpp-options: -DBOOTSTRAP_TH + build-depends: + ghc-prim + , pretty + -- we vendor ghc-boot-th and template-haskell while bootstrapping TH. + -- This is to avoid having two copies of ghc-boot-th and template-haskell + -- in the build graph: one from the boot compiler and the in-tree one. + hs-source-dirs: . ../ghc-boot-th ../template-haskell ../template-haskell/vendored-filepath + exposed-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Lib + , Language.Haskell.TH.Ppr + , Language.Haskell.TH.PprLib + , Language.Haskell.TH.Quote + , Language.Haskell.TH.Syntax + , Language.Haskell.TH.LanguageExtensions + , Language.Haskell.TH.CodeDo + , Language.Haskell.TH.Lib.Internal + + other-modules: + Language.Haskell.TH.Lib.Map + , System.FilePath + , System.FilePath.Posix + , System.FilePath.Windows + else + hs-source-dirs: . + build-depends: + ghc-boot-th == @ProjectVersionMunged@ + , template-haskell == 2.22.0.0 + -- reexport modules from ghc-boot-th and template-haskell so that packages + -- don't have to import all of ghc-boot, ghc-boot-th and template-haskell. + -- It makes the dependency graph easier to understand and to refactor + -- and reduces the amount of cabal flags we need to use for bootstrapping TH. + reexported-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Syntax if !os(windows) build-depends: unix >= 2.7 && < 2.9 ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -84,7 +84,6 @@ library filepath >= 1.4 && < 1.6, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, - template-haskell == 2.22.*, transformers >= 0.5 && < 0.7 if !os(windows) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -34,13 +34,12 @@ module Language.Haskell.TH.Syntax -- $infix ) where -import qualified Data.Fixed as Fixed +import Prelude import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import System.FilePath import GHC.IO.Unsafe ( unsafeDupableInterleaveIO ) -import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Fix (MonadFix (..)) import Control.Applicative (Applicative(..)) @@ -48,35 +47,42 @@ import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO) import Control.Exception.Base (FixIOException (..)) import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar) import System.IO ( hPutStrLn, stderr ) -import Data.Char ( isAlpha, isAlphaNum, isUpper, ord ) +import Data.Char ( isAlpha, isAlphaNum, isUpper ) import Data.Int import Data.List.NonEmpty ( NonEmpty(..) ) -import Data.Void ( Void, absurd ) import Data.Word import Data.Ratio -import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) -import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), - TYPE, RuntimeRep(..), Levity(..), 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 ) import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions -import Numeric.Natural import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types +#ifdef BOOTSTRAP_TH +import GHC.Types (TYPE, RuntimeRep(..), Levity(..)) +#else +import Control.Monad (liftM) +import Data.Char (ord) +import qualified Data.Fixed as Fixed +import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) +import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), + TYPE, RuntimeRep(..), Levity(..) ) +import GHC.CString ( unpackCString# ) +import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) +import Data.Void ( Void, absurd ) +import Numeric.Natural import Data.Array.Byte (ByteArray(..)) import GHC.Exts ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray# , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents# , copyByteArray#, newPinnedByteArray#) -import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) import GHC.ST (ST(..), runST) +#endif ----------------------------------------------------- -- @@ -1018,6 +1024,7 @@ class Lift (t :: TYPE r) where liftTyped :: Quote m => t -> Code m t +#ifndef BOOTSTRAP_TH -- If you add any instances here, consider updating test th/TH_Lift instance Lift Integer where liftTyped x = unsafeCodeCoerce (lift x) @@ -1384,10 +1391,11 @@ rightName = 'Right nonemptyName :: Name nonemptyName = '(:|) +#endif oneName, manyName :: Name -oneName = 'One -manyName = 'Many +oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" +manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" ----------------------------------------------------- -- ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Posix ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Windows ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af633d6cb2b0829cd1d50156c70f8510874baf58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af633d6cb2b0829cd1d50156c70f8510874baf58 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 10:08:23 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 04 Apr 2024 06:08:23 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 55 commits: rts: Fix TSAN_ENABLED CPP guard Message-ID: <660e7c17b3071_15494ce7cbc41002a5@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 6a38d7b6 by Rodrigo Mesquita at 2024-04-04T11:08:06+01:00 loader: Note down suggestion for needed_mods The associated ticket is #24600 - - - - - a7e985fb by Rodrigo Mesquita at 2024-04-04T11:08:07+01:00 rts: free error message before returning Fixes a memory leak in rts/linker/PEi386.c - - - - - 8b985376 by Alexis King at 2024-04-04T11:08:07+01:00 linker: Avoid linear search when looking up Haskell symbols via dlsym See the primary Note [Looking up symbols in the relevant objects] for a more in-depth explanation. When dynamically loading a Haskell symbol (typical when running a splice or GHCi expression), before this commit we would search for the symbol in all dynamic libraries that were loaded. However, this could be very inefficient when too many packages are loaded (which can happen if there are many package dependencies) because the time to lookup the would be linear in the number of packages loaded. This commit drastically improves symbol loading performance by introducing a mapping from units to the handles of corresponding loaded dlls. These handles are returned by dlopen when we load a dll, and can then be used to look up in a specific dynamic library. Looking up a given Name is now much more precise because we can get lookup its unit in the mapping and lookup the symbol solely in the handles of the dynamic libraries loaded for that unit. In one measurement, the wait time before the expression was executed went from +-38 seconds down to +-2s. This commit also includes Note [Symbols may not be found in pkgs_loaded], explaining the fallback to the old behaviour in case no dll can be found in the unit mapping for a given Name. Fixes #23415 Co-authored-by: Rodrigo Mesquita (@alt-romes) - - - - - 38a83ce0 by Rodrigo Mesquita at 2024-04-04T11:08:07+01:00 rts: Make addDLL a wrapper around loadNativeObj Rewrite the implementation of `addDLL` as a wrapper around the more principled `loadNativeObj` rts linker function. The latter should be preferred while the former is preserved for backwards compatibility. `loadNativeObj` was previously only available on ELF platforms, so this commit further refactors the rts linker to transform loadNativeObj_ELF into loadNativeObj_POSIX, which is available in ELF and MachO platforms. The refactor made it possible to remove the `dl_mutex` mutex in favour of always using `linker_mutex` (rather than a combination of both). Lastly, we implement `loadNativeObj` for Windows too. - - - - - d50ce08d by Rodrigo Mesquita at 2024-04-04T11:08:07+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 1a021a8a by Ben Gamari at 2024-04-04T11:08:07+01:00 testsuite: Add test for lookupSymbolInNativeObj - - - - - 17 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/00f908b07ae52b0ecfea90eb708a309da0257abe...1a021a8a4cfe4ee06b840611d035d99191ad5ac8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/00f908b07ae52b0ecfea90eb708a309da0257abe...1a021a8a4cfe4ee06b840611d035d99191ad5ac8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 10:22:59 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Thu, 04 Apr 2024 06:22:59 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] Make template-haskell a stage1 package Message-ID: <660e7f83d93a_15494c10a0cfc1021a8@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: 840fe186 by Teo Camarasu at 2024-04-04T11:22:50+01:00 Make template-haskell a stage1 package Promoting template-haskell from a stage0 to a stage1 package means that we can much more easily refactor template-haskell. In order to accomplish this we now compile stage0 packages using the boot compiler's version of template-haskell. This means that there are now two versions of template-haskell in play: the boot compiler's version, and the in-tree version. When compiling the stage1 compiler, we have to pick a version of template-haskell to use. During bootstrapping we want to use the same version as the final compiler. This forces the in-tree version. We are only able to use the internal interpreter with stage2 onwards. Yet, we could still use the external interpreter. The external interpreter runs splices in another process. Queries and results are seralised. This reduces our compatibility requirements from ABI compatibility with the internal interpreter to mere serialisation compatibility. We may compile GHC against another library to what the external interpreter is compiled against so long as it has exactly the same serialisation of template-haskell types. This opens up the strategy pursued in this patch. When compiling the stage1 compiler we vendor the template-haskell and ghc-boot-th libraries through ghc-boot and use these to define the Template Haskell interface for the external interpreter. Note that at this point we also have the template-haskell and ghc-boot-th packages in our transitive dependency closure from the boot compiler, and some packages like containers have dependencies on these to define Lift instances. Then the external interpreter should be compiled against the regular template-haskell library from the source tree. As this will have the same serialised interface as what we vendor in ghc-boot, we can then run splices. GHC stage2 is compiled as normal as well against the template-haskell library from the source tree. Resolves #23536 - - - - - 10 changed files: - compiler/ghc.cabal.in - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -115,7 +115,6 @@ Library containers >= 0.6.2.1 && < 0.8, array >= 0.1 && < 0.6, filepath >= 1 && < 1.6, - template-haskell == 2.22.*, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -35,7 +35,10 @@ extra_dependencies = where th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") - dep (p1, m1) (p2, m2) s = do + dep (p1, m1) (p2, m2) s = + -- We use the boot compiler's `template-haskell` library when building stage0, + -- so we don't need to register dependencies. + if isStage0 s then pure [] else do let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set") ways <- interpretInContext context getLibraryWays mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways) ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,7 +158,6 @@ toolTargets = [ binary -- , ghc -- # depends on ghc library -- , runGhc -- # depends on ghc library , ghcBoot - , ghcBootTh , ghcPlatform , ghcToolchain , ghcToolchainBin @@ -172,7 +171,6 @@ toolTargets = [ binary , mtl , parsec , time - , templateHaskell , text , transformers , semaphoreCompat ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -93,7 +93,6 @@ stage0Packages = do , ghc , runGhc , ghcBoot - , ghcBootTh , ghcPlatform , ghcHeap , ghcToolchain @@ -108,7 +107,6 @@ stage0Packages = do , parsec , semaphoreCompat , time - , templateHaskell , text , transformers , unlit @@ -143,6 +141,7 @@ stage1Packages = do , deepseq , exceptions , ghc + , ghcBootTh , ghcBignum , ghcCompact , ghcExperimental @@ -156,6 +155,7 @@ stage1Packages = do , pretty , rts , semaphoreCompat + , templateHaskell , stm , unlit , xhtml ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -121,6 +121,10 @@ packageArgs = do , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ? input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ] + -------------------------------- ghcBoot ------------------------------ + , package ghcBoot ? + builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap-th") + --------------------------------- ghci --------------------------------- , package ghci ? mconcat [ ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -35,6 +35,11 @@ source-repository head location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/ghc-boot +Flag bootstrap-th + Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib + Default: False + Manual: True + Library default-language: Haskell2010 other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables @@ -56,13 +61,6 @@ Library GHC.UniqueSubdir GHC.Version - -- reexport modules from ghc-boot-th so that packages don't have to import - -- both ghc-boot and ghc-boot-th. It makes the dependency graph easier to - -- understand and to refactor. - reexported-modules: - GHC.LanguageExtensions.Type - , GHC.ForeignSrcLang.Type - , GHC.Lexeme -- reexport platform modules from ghc-platform reexported-modules: @@ -81,7 +79,49 @@ Library filepath >= 1.3 && < 1.6, deepseq >= 1.4 && < 1.6, ghc-platform >= 0.1, - ghc-boot-th == @ProjectVersionMunged@ + if flag(bootstrap-th) + cpp-options: -DBOOTSTRAP_TH + build-depends: + ghc-prim + , pretty + -- we vendor ghc-boot-th and template-haskell while bootstrapping TH. + -- This is to avoid having two copies of ghc-boot-th and template-haskell + -- in the build graph: one from the boot compiler and the in-tree one. + hs-source-dirs: . ../ghc-boot-th ../template-haskell ../template-haskell/vendored-filepath + exposed-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Lib + , Language.Haskell.TH.Ppr + , Language.Haskell.TH.PprLib + , Language.Haskell.TH.Quote + , Language.Haskell.TH.Syntax + , Language.Haskell.TH.LanguageExtensions + , Language.Haskell.TH.CodeDo + , Language.Haskell.TH.Lib.Internal + + other-modules: + Language.Haskell.TH.Lib.Map + , System.FilePath + , System.FilePath.Posix + , System.FilePath.Windows + else + hs-source-dirs: . + build-depends: + ghc-boot-th == @ProjectVersionMunged@ + , template-haskell == 2.22.0.0 + -- reexport modules from ghc-boot-th and template-haskell so that packages + -- don't have to import all of ghc-boot, ghc-boot-th and template-haskell. + -- It makes the dependency graph easier to understand and to refactor + -- and reduces the amount of cabal flags we need to use for bootstrapping TH. + reexported-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Syntax if !os(windows) build-depends: unix >= 2.7 && < 2.9 ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -84,7 +84,6 @@ library filepath >= 1.4 && < 1.6, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, - template-haskell == 2.22.*, transformers >= 0.5 && < 0.7 if !os(windows) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -34,49 +34,54 @@ module Language.Haskell.TH.Syntax -- $infix ) where -import qualified Data.Fixed as Fixed +import Prelude import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import System.FilePath import GHC.IO.Unsafe ( unsafeDupableInterleaveIO ) -import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Fix (MonadFix (..)) -import Control.Applicative (Applicative(..)) import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO) import Control.Exception.Base (FixIOException (..)) import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar) import System.IO ( hPutStrLn, stderr ) -import Data.Char ( isAlpha, isAlphaNum, isUpper, ord ) +import Data.Char ( isAlpha, isAlphaNum, isUpper ) import Data.Int import Data.List.NonEmpty ( NonEmpty(..) ) -import Data.Void ( Void, absurd ) import Data.Word import Data.Ratio -import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) -import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), - TYPE, RuntimeRep(..), Levity(..), 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 ) import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions -import Numeric.Natural import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types +#ifdef BOOTSTRAP_TH +import GHC.Types (TYPE, RuntimeRep(..), Levity(..)) +#else +import Control.Monad (liftM) +import Data.Char (ord) +import qualified Data.Fixed as Fixed +import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) +import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), + TYPE, RuntimeRep(..), Levity(..) ) +import GHC.CString ( unpackCString# ) +import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) +import Data.Void ( Void, absurd ) +import Numeric.Natural import Data.Array.Byte (ByteArray(..)) import GHC.Exts ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray# , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents# , copyByteArray#, newPinnedByteArray#) -import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) import GHC.ST (ST(..), runST) +#endif ----------------------------------------------------- -- @@ -1018,6 +1023,7 @@ class Lift (t :: TYPE r) where liftTyped :: Quote m => t -> Code m t +#ifndef BOOTSTRAP_TH -- If you add any instances here, consider updating test th/TH_Lift instance Lift Integer where liftTyped x = unsafeCodeCoerce (lift x) @@ -1384,10 +1390,11 @@ rightName = 'Right nonemptyName :: Name nonemptyName = '(:|) +#endif oneName, manyName :: Name -oneName = 'One -manyName = 'Many +oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" +manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" ----------------------------------------------------- -- ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Posix ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Windows ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/840fe186f95e24b9a8e690af1fd78b6dfaaff475 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/840fe186f95e24b9a8e690af1fd78b6dfaaff475 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 10:31:23 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Thu, 04 Apr 2024 06:31:23 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] 2 commits: Refactor the Binary serialisation interface Message-ID: <660e817b105_15494c125258c10531@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: 6c752256 by Fendor at 2024-04-04T10:11:42+02:00 Refactor the Binary serialisation interface The end goal is to dynamically add deduplication tables for `ModIface` interface serialisation. We identify two main points of interest that make this difficult: 1. UserData hardcodes what `Binary` instances can have deduplication tables. Moreover, it heavily uses partial functions. 2. GHC.Iface.Binary hardcodes the deduplication tables for 'Name' and 'FastString', making it difficult to add more deduplication. Instead of having a single `UserData` record with fields for all the types that can have deduplication tables, we allow to provide custom serialisers for any `Typeable`. These are wrapped in existentials and stored in a `Map` indexed by their respective `TypeRep`. The `Binary` instance of the type to deduplicate still needs to explicitly look up the decoder via `findUserDataReader` and `findUserDataWriter`, which is no worse than the status-quo. `Map` was chosen as microbenchmarks indicate it is the fastest for a small number of keys (< 10). To generalise the deduplication table serialisation mechanism, we introduce the types `ReaderTable` and `WriterTable` which provide a simple interface that is sufficient to implement a general purpose deduplication mechanism for `writeBinIface` and `readBinIface`. This allows us to provide a list of deduplication tables for serialisation that can be extended more easily, for example for `IfaceTyCon`, see the issue https://gitlab.haskell.org/ghc/ghc/-/issues/24540 for more motivation. In addition to ths refactoring, we split `UserData` into `ReaderUserData` and `WriterUserData`, to avoid partial functions. Bump haddock submodule to accomodate for `UserData` split. - - - - - 5935848a by Fendor at 2024-04-04T12:00:36+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 15 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -29,7 +29,6 @@ module GHC.Iface.Binary ( import GHC.Prelude -import GHC.Tc.Utils.Monad import GHC.Builtin.Utils ( isKnownKeyName, lookupKnownKeyName ) import GHC.Unit import GHC.Unit.Module.ModIface @@ -54,6 +53,9 @@ import Data.Char import Data.Word import Data.IORef import Control.Monad +import Data.Functor.Identity +import Data.Bifunctor (Bifunctor(second)) +import Data.Coerce -- --------------------------------------------------------------------------- -- Reading and writing binary interface files @@ -75,7 +77,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -121,6 +123,8 @@ readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do pure (src_hash, bh) -- | Read an interface file. +-- +-- See Note [Iface Binary Serialisation] for details. readBinIface :: Profile -> NameCache @@ -135,7 +139,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -146,7 +150,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -154,24 +158,33 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do - -- Read the dictionary - -- The next word in the file is a pointer to where the dictionary is - -- (probably at the end of the file) - dict <- Binary.forwardGet bh (getDictionary bh) - - -- Initialise the user-data field of bh - let bh_fs = setUserData bh $ newReadState (error "getSymtabName") - (getDictFastString dict) - - symtab <- Binary.forwardGet bh_fs (getSymbolTable bh_fs name_cache) - - -- It is only now that we know how to get a Name - return $ setUserData bh $ newReadState (getSymtabName name_cache dict symtab) - (getDictFastString dict) - --- | Write an interface file + let + -- The order of these entries matters! + -- + -- See Note [Iface Binary Serialiser Order] for details. + tables :: [SomeReaderTable IO] + tables = + [ SomeReaderTable initFastStringReaderTable + , SomeReaderTable (initReadNameCachedBinary name_cache) + , SomeReaderTable @IO @BindingName (coerce (initReadNameCachedBinary name_cache)) + ] + + tables <- traverse (\(SomeReaderTable tblM) -> tblM >>= pure . SomeReaderTable . pure) tables + + final_bh <- foldM (\bh (SomeReaderTable (tbl' :: Identity (ReaderTable a))) -> do + let tbl = runIdentity tbl' + res <- Binary.forwardGet bh (getTable tbl bh) + let newDecoder = mkReaderFromTable tbl res + pure $ addReaderToUserData (mkSomeBinaryReader newDecoder) bh + ) bh tables + + pure final_bh + +-- | Write an interface file. +-- +-- See Note [Iface Binary Serialisation] for details. writeBinIface :: Profile -> TraceBinIFace -> FilePath -> ModIface -> IO () writeBinIface profile traceBinIface hi_path mod_iface = do bh <- openBinMem initBinMemSize @@ -184,14 +197,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -201,7 +214,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -225,43 +238,40 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int,Int,b) -putWithTables bh put_payload = do - -- initialize state for the name table and the FastString table. - symtab_next <- newFastMutInt 0 - symtab_map <- newIORef emptyUFM - let bin_symtab = BinSymbolTable - { bin_symtab_next = symtab_next - , bin_symtab_map = symtab_map - } - - (bh_fs, bin_dict, put_dict) <- initFSTable bh - - (fs_count,(name_count,r)) <- forwardPut bh (const put_dict) $ do - - -- NB. write the dictionary after the symbol table, because - -- writing the symbol table may create more dictionary entries. - let put_symtab = do - name_count <- readFastMutInt symtab_next - symtab_map <- readIORef symtab_map - putSymbolTable bh_fs name_count symtab_map - pure name_count - - forwardPut bh_fs (const put_symtab) $ do - - -- BinHandle with FastString and Name writing support - let ud_fs = getUserData bh_fs - let ud_name = ud_fs - { ud_put_nonbinding_name = putName bin_dict bin_symtab - , ud_put_binding_name = putName bin_dict bin_symtab - } - let bh_name = setUserData bh ud_name - - put_payload bh_name - - return (name_count, fs_count, r) - - +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) +putWithTables bh' put_payload = do + let + -- The order of these entries matters! + -- + -- See Note [Iface Binary Serialiser Order] for details. + writerTables = + [ SomeWriterTable initFastStringWriterTable + , SomeWriterTable initWriteNameTable + , SomeWriterTable (fmap (second (\(BinaryWriter f) -> BinaryWriter (\bh name -> f bh (getBindingName name)))) initWriteNameTable) + ] + + tables <- traverse (\(SomeWriterTable worker) -> worker >>= pure . SomeWriterTable . pure) writerTables + + let writerUserData = + mkWriterUserData $ + map + (\(SomeWriterTable tbl') -> mkSomeBinaryWriter (snd $ runIdentity tbl')) + tables + + let bh = setWriterUserData bh' writerUserData + (fs_count : name_count : _, r) <- + putAllTables bh (fmap (\(SomeWriterTable tbl) -> fst $ runIdentity tbl) tables) $ do + put_payload bh + + return (name_count, fs_count, r) + where + putAllTables _ [] act = do + a <- act + pure ([], a) + putAllTables bh (x : xs) act = do + (r, (res, a)) <- forwardPut bh (const $ putTable x bh) $ do + putAllTables bh xs act + pure (r : res, a) -- | Initial ram buffer to allocate for writing interface files initBinMemSize :: Int @@ -273,11 +283,108 @@ binaryInterfaceMagic platform | otherwise = FixedLengthEncoding 0x1face64 +{- +Note [Iface Binary Serialisation] +~~~~~~~~~~~~~~~~~~~ +When we serialise a 'ModIface', many symbols are redundant. +For example, there can be duplicated 'FastString's and 'Name's. +To save space, we deduplicate some symbols, such as 'FastString' and 'Name', +by maintaining a table of already seen symbols. +When serialising a symbol, we lookup whether we have encountered the symbol before. +If yes, we write the index of the symbol, otherwise we generate a new index and store it in the table. + +Besides saving a lot of disk space, this additionally enables us to automatically share +these symbols when we read the 'ModIface' from disk, without additional mechanisms such as 'FastStringTable'. + +Note [Iface Binary Serialiser Order] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Serialisation of 'ModIface' uses tables to deduplicate symbols that occur often. + +After 'ModIface' has been written to disk, we write the deduplication tables. +Writing a table may add additional entries to *other* deduplication tables, thus +we need to make sure that the symbol table we serialise only depends on +deduplication tables that haven't been written to disk yet. + +For example, assume we maintain deduplication tables for 'FastString' and 'Name'. +The symbol 'Name' depends on 'FastString', so serialising a 'Name' may add a 'FastString' +to the 'FastString' deduplication table. +Thus, 'Name' table needs to be serialised to disk before the 'FastString' table. + +When we read the 'ModIface' from disk, we consequentially need to read the 'FastString' +deduplication table from disk, before we can deserialise the 'Name' deduplication table. +Therefore, before we serialise the tables, we write forward pointers that allow us to jump ahead +to the table we need to deserialise first. + +Here, a visualisation of the table structure we currently have: + +┌──────────────┐ +│ Headers │ +├──────────────┤ +│ │ +│ ModIface │ +│ Payload │ +│ │ +├──────────────┤ +│ Ptr FS ├───────────┐ +├──────────────┤ │ +│ Ptr Name ├────────┐ │ +├──────────────┤ │ │ +│ │ │ │ +│ Name Table │◄───────┘ │ +│ │ │ +├──────────────┤ │ +│ │ │ +│ FS Table │◄──────────┘ +│ │ +└──────────────┘ + +-} + + -- ----------------------------------------------------------------------------- -- The symbol table -- -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () + +initReadNameCachedBinary :: NameCache -> IO (ReaderTable Name) +initReadNameCachedBinary cache = do + return $ + ReaderTable + { getTable = \bh -> getSymbolTable bh cache + , mkReaderFromTable = \tbl -> mkReader (getSymtabName tbl) + } + +data BinSymbolTable = BinSymbolTable { + bin_symtab_next :: !FastMutInt, -- The next index to use + bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) + -- indexed by Name + } + +initWriteNameTable :: IO (WriterTable, BinaryWriter Name) +initWriteNameTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef emptyUFM + let bin_symtab = + BinSymbolTable + { bin_symtab_next = symtab_next + , bin_symtab_map = symtab_map + } + + let put_symtab bh = do + name_count <- readFastMutInt symtab_next + symtab_map <- readIORef symtab_map + putSymbolTable bh name_count symtab_map + pure name_count + + return + ( WriterTable + { putTable = put_symtab + } + , mkWriter $ putName bin_symtab + ) + + +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -286,7 +393,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -307,7 +414,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -331,8 +438,8 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: FSTable -> BinSymbolTable -> BinHandle -> Name -> IO () -putName _dict BinSymbolTable{ +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () +putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } bh name @@ -356,10 +463,9 @@ putName _dict BinSymbolTable{ put_ bh (fromIntegral off :: Word32) -- See Note [Symbol table representation of names] -getSymtabName :: NameCache - -> Dictionary -> SymbolTable - -> BinHandle -> IO Name -getSymtabName _name_cache _dict symtab bh = do +getSymtabName :: SymbolTable Name + -> ReadBinHandle -> IO Name +getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of 0x00000000 -> return $! symtab ! fromIntegral i @@ -376,10 +482,3 @@ getSymtabName _name_cache _dict symtab bh = do Just n -> n _ -> pprPanic "getSymtabName:unknown name tag" (ppr i) - -data BinSymbolTable = BinSymbolTable { - bin_symtab_next :: !FastMutInt, -- The next index to use - bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) - -- indexed by Name - } - ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -105,15 +105,16 @@ writeHieFile hie_file_path hiefile = do hie_dict_map = dict_map_ref } -- put the main thing - let bh = setUserData bh0 $ newWriteState (putName hie_symtab) - (putName hie_symtab) - (putFastString hie_dict) + let bh = setWriterUserData bh0 + $ newWriteState (putName hie_symtab) + (putName hie_symtab) + (putFastString hie_dict) put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next @@ -121,9 +122,9 @@ writeHieFile hie_file_path hiefile = do putSymbolTable bh symtab_next' symtab_map' -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -181,7 +182,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -190,7 +191,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -213,15 +214,16 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data bh1 <- do - let bh1 = setUserData bh0 $ newReadState (error "getSymtabName") - (getDictFastString dict) + let bh1 = setReaderUserData bh0 + $ newReadState (error "getSymtabName") + (getDictFastString dict) symtab <- get_symbol_table bh1 - let bh1' = setUserData bh1 + let bh1' = setReaderUserData bh1 $ newReadState (getSymTabName symtab) (getDictFastString dict) return bh1' @@ -231,21 +233,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -259,13 +261,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -275,12 +277,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -333,7 +335,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -344,7 +346,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -1032,7 +1032,7 @@ addFingerprints hsc_env iface0 -- change if the fingerprint for anything it refers to (transitively) -- changes. mk_put_name :: OccEnv (OccName,Fingerprint) - -> BinHandle -> Name -> IO () + -> WriteBinHandle -> Name -> IO () mk_put_name local_env bh name | isWiredInName name = putNameLiterally bh name -- wired-in names don't have fingerprints ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -26,7 +26,7 @@ fingerprintBinMem bh = withBinBuffer bh f in fp `seq` return fp computeFingerprint :: (Binary a) - => (BinHandle -> Name -> IO ()) + => (WriteBinHandle -> Name -> IO ()) -> a -> IO Fingerprint computeFingerprint put_nonbinding_name a = do @@ -35,11 +35,11 @@ computeFingerprint put_nonbinding_name a = do fingerprintBinMem bh where set_user_data bh = - setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS + setWriterUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -31,7 +31,7 @@ import System.FilePath (normalise) -- NB: The 'Module' parameter is the 'Module' recorded by the *interface* -- file, not the actual 'Module' according to our 'DynFlags'. fingerprintDynFlags :: HscEnv -> Module - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintDynFlags hsc_env this_mod nameio = @@ -81,7 +81,7 @@ fingerprintDynFlags hsc_env this_mod nameio = -- object files as they can. -- See Note [Ignoring some flag changes] fingerprintOptFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintOptFlags DynFlags{..} nameio = let @@ -99,7 +99,7 @@ fingerprintOptFlags DynFlags{..} nameio = -- file compiled for HPC when not actually using HPC. -- See Note [Ignoring some flag changes] fingerprintHpcFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintHpcFlags dflags at DynFlags{..} nameio = let ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith, import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Proxy infixl 3 &&& @@ -118,15 +119,19 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr -getIfaceTopBndr bh = get bh +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr +getIfaceTopBndr bh = + case findUserDataReader (Proxy @BindingName) bh of + tbl -> + --pprTrace "putIfaceTopBndr" (ppr name) $ + getBindingName <$> getEntry tbl bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = - case getUserData bh of - UserData{ ud_put_binding_name = put_binding_name } -> + case findUserDataWriter (Proxy @BindingName) bh of + tbl -> --pprTrace "putIfaceTopBndr" (ppr name) $ - put_binding_name bh name + putEntry tbl bh (BindingName name) data IfaceDecl @@ -2444,13 +2449,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -9,7 +9,6 @@ This module defines interface types and binders {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE LambdaCase #-} - module GHC.Iface.Type ( IfExtName, IfLclName, @@ -90,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ @@ -2045,11 +2044,12 @@ instance Outputable IfaceCoercion where ppr = pprIfaceCoercion instance Binary IfaceTyCon where - put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i + put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i - get bh = do n <- get bh - i <- get bh - return (IfaceTyCon n i) + get bh = do + n <- get bh + i <- get bh + return (IfaceTyCon n i) instance Binary IfaceTyConSort where put_ bh IfaceNormalTyCon = putByte bh 0 ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -66,6 +66,9 @@ import GHC.Prelude import Control.Monad import Data.Array +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import Data.Char (isSpace) import Data.Int import Data.IntSet (IntSet) import qualified Data.IntSet as IS @@ -75,10 +78,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Word import Data.Semigroup -import qualified Data.ByteString as B -import qualified Data.ByteString.Unsafe as B -import Data.Char (isSpace) -import System.IO +import System.IO import GHC.Settings.Constants (hiVersion) @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -313,15 +313,16 @@ putObject bh mod_name deps os = do -- object in an archive. put_ bh (moduleNameString mod_name) - (bh_fs, _bin_dict, put_dict) <- initFSTable bh + (fs_tbl, fs_writer) <- initFastStringWriterTable + let bh_fs = addWriterToUserData (mkSomeBinaryWriter fs_writer) bh - forwardPut_ bh (const put_dict) $ do + forwardPut_ bh (const (putTable fs_tbl bh_fs)) $ do put_ bh_fs deps -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -329,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -344,15 +345,15 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) - let bh = setUserData bh0 $ noUserData { ud_get_fs = getDictFastString dict } + let bh = setReaderUserData bh0 $ newReadState (panic "No name allowed") (getDictFastString dict) block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -363,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -392,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -408,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -778,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -1010,7 +1010,7 @@ data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple - deriving( Eq, Data ) + deriving( Eq, Data, Ord ) instance Outputable TupleSort where ppr ts = text $ ===================================== compiler/GHC/Types/FieldLabel.hs ===================================== @@ -140,14 +140,14 @@ instance Binary Name => Binary FieldLabel where put_ bh (FieldLabel aa ab ac) = do put_ bh aa put_ bh ab - case getUserData bh of - UserData{ ud_put_binding_name = put_binding_name } -> - put_binding_name bh ac + case findUserDataWriter (Proxy @BindingName) bh of + tbl -> putEntry tbl bh (BindingName ac) get bh = do aa <- get bh ab <- get bh - ac <- get bh - return (FieldLabel aa ab ac) + ac <- case findUserDataReader (Proxy @BindingName) bh of + tbl -> getEntry tbl bh + return (FieldLabel aa ab $ getBindingName ac) flIsOverloaded :: FieldLabel -> Bool flIsOverloaded fl = ===================================== compiler/GHC/Types/Name.hs ===================================== @@ -663,12 +663,12 @@ instance Data Name where -- distinction. instance Binary Name where put_ bh name = - case getUserData bh of - UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name + case findUserDataWriter Proxy bh of + tbl -> putEntry tbl bh name get bh = - case getUserData bh of - UserData { ud_get_name = get_name } -> get_name bh + case findUserDataReader Proxy bh of + tbl -> getEntry tbl bh {- ************************************************************************ ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -4,6 +4,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-} +{-# LANGUAGE TypeFamilies #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected @@ -21,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -30,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -66,15 +69,30 @@ module GHC.Utils.Binary lazyPutMaybe, -- * User data - UserData(..), getUserData, setUserData, - newReadState, newWriteState, noUserData, - + ReaderUserData(..), getReaderUserData, setReaderUserData, noReaderUserData, + WriterUserData(..), getWriterUserData, setWriterUserData, noWriterUserData, + mkWriterUserData, mkReaderUserData, + newReadState, newWriteState, + addReaderToUserData, addWriterToUserData, + findUserDataReader, findUserDataWriter, + -- * Binary Readers & Writers + BinaryReader(..), BinaryWriter(..), + mkWriter, mkReader, + SomeBinaryReader, SomeBinaryWriter, + mkSomeBinaryReader, mkSomeBinaryWriter, + -- * Tables + SomeReaderTable(..), + ReaderTable(..), + SomeWriterTable(..), + WriterTable(..), -- * String table ("dictionary") + initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, - FSTable, initFSTable, getDictFastString, putDictFastString, - + FSTable(..), getDictFastString, putDictFastString, -- * Newtype wrappers - BinSpan(..), BinSrcSpan(..), BinLocated(..) + BinSpan(..), BinSrcSpan(..), BinLocated(..), + -- * Newtypes for types that have canonically more than one valid encoding + BindingName(..), ) where import GHC.Prelude @@ -93,6 +111,7 @@ import qualified GHC.Data.Strict as Strict import GHC.Utils.Outputable( JoinPointHood(..) ) import Control.DeepSeq +import Control.Monad ( when, (<$!>), unless, forM_, void ) import Foreign hiding (shiftL, shiftR, void) import Data.Array import Data.Array.IO @@ -104,11 +123,13 @@ import Data.IORef import Data.Char ( ord, chr ) import Data.List.NonEmpty ( NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Data.Set ( Set ) import qualified Data.Set as Set import Data.Time import Data.List (unfoldr) -import Control.Monad ( when, (<$!>), unless, forM_, void ) +import Data.Typeable import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Error ( mkIOError, eofErrorType ) @@ -119,6 +140,9 @@ import qualified Data.IntMap as IntMap import GHC.ForeignPtr ( unsafeWithForeignPtr ) #endif +import Unsafe.Coerce (unsafeCoerce) +import Data.Coerce + type BinArray = ForeignPtr Word8 #if !MIN_VERSION_base(4,15,0) @@ -150,49 +174,83 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_usr :: UserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: !WriterUserData, + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getUserData :: BinHandle -> UserData -getUserData bh = bh_usr bh +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: !ReaderUserData, + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) + } + +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh + +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setUserData :: BinHandle -> UserData -> BinHandle -setUserData bh us = bh { bh_usr = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } + +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } + +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle +addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) + } + } + +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle +addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) + } + } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -211,23 +269,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -235,42 +293,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } + +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -279,20 +352,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -313,7 +389,7 @@ expandBin (BinMem _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -329,7 +405,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -350,8 +426,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -372,39 +448,37 @@ putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -412,7 +486,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -425,7 +499,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -437,7 +511,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -458,10 +532,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -484,15 +558,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -509,15 +583,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -533,15 +607,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -561,15 +635,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -980,63 +1054,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1044,14 +1118,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1062,7 +1136,9 @@ lazyGetMaybe bh = do -- UserData -- ----------------------------------------------------------------------------- --- | Information we keep around during interface file +-- Note [Binary UserData] +-- ~~~~~~~~~~~~~~~~~~~~~~ +-- Information we keep around during interface file -- serialization/deserialization. Namely we keep the functions for serializing -- and deserializing 'Name's and 'FastString's. We do this because we actually -- use serialization in two distinct settings, @@ -1081,73 +1157,197 @@ lazyGetMaybe bh = do -- non-binding Name is serialized as the fingerprint of the thing they -- represent. See Note [Fingerprinting IfaceDecls] for further discussion. -- -data UserData = - UserData { - -- for *deserialising* only: - ud_get_name :: BinHandle -> IO Name, - ud_get_fs :: BinHandle -> IO FastString, - - -- for *serialising* only: - ud_put_nonbinding_name :: BinHandle -> Name -> IO (), - -- ^ serialize a non-binding 'Name' (e.g. a reference to another - -- binding). - ud_put_binding_name :: BinHandle -> Name -> IO (), - -- ^ serialize a binding 'Name' (e.g. the name of an IfaceDecl) - ud_put_fs :: BinHandle -> FastString -> IO () + +-- | Newtype to serialise binding names differently to non-binding 'Name'. +-- See Note [Binary UserData] +newtype BindingName = BindingName { getBindingName :: Name } + deriving ( Eq ) + +-- | Existential for 'BinaryWriter' with a type witness. +data SomeBinaryWriter = forall a . SomeBinaryWriter TypeRep (BinaryWriter a) + +-- | Existential for 'BinaryReader' with a type witness. +data SomeBinaryReader = forall a . SomeBinaryReader TypeRep (BinaryReader a) + +-- | UserData required to serialise symbols for interface files. +-- +-- See Note [Binary UserData] +data WriterUserData = + WriterUserData { + ud_writer_data :: Map TypeRep SomeBinaryWriter + -- ^ A mapping from a type witness to the 'Writer' for the associated type. + -- This is a 'Map' because microbenchmarks indicated this is more efficient + -- than other representations for less than ten elements. + -- + -- Considered representations: + -- + -- * [(TypeRep, SomeBinaryWriter)] + -- * bytehash (on hackage) + -- * Map TypeRep SomeBinaryWriter } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) - -> UserData -newReadState get_name get_fs - = UserData { ud_get_name = get_name, - ud_get_fs = get_fs, - ud_put_nonbinding_name = undef "put_nonbinding_name", - ud_put_binding_name = undef "put_binding_name", - ud_put_fs = undef "put_fs" - } - -newWriteState :: (BinHandle -> Name -> IO ()) +-- | UserData required to deserialise symbols for interface files. +-- +-- See Note [Binary UserData] +data ReaderUserData = + ReaderUserData { + ud_reader_data :: Map TypeRep SomeBinaryReader + -- ^ A mapping from a type witness to the 'Reader' for the associated type. + -- This is a 'Map' because microbenchmarks indicated this is more efficient + -- than other representations for less than ten elements. + -- + -- Considered representations: + -- + -- * [(TypeRep, SomeBinaryReader)] + -- * bytehash (on hackage) + -- * Map TypeRep SomeBinaryReader + } + +mkWriterUserData :: [SomeBinaryWriter] -> WriterUserData +mkWriterUserData caches = noWriterUserData + { ud_writer_data = Map.fromList $ map (\cache@(SomeBinaryWriter typRep _) -> (typRep, cache)) caches + } + +mkReaderUserData :: [SomeBinaryReader] -> ReaderUserData +mkReaderUserData caches = noReaderUserData + { ud_reader_data = Map.fromList $ map (\cache@(SomeBinaryReader typRep _) -> (typRep, cache)) caches + } + +mkSomeBinaryWriter :: forall a . Typeable a => BinaryWriter a -> SomeBinaryWriter +mkSomeBinaryWriter cb = SomeBinaryWriter (typeRep (Proxy :: Proxy a)) cb + +mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReader +mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb + +data BinaryReader s = BinaryReader + { getEntry :: ReadBinHandle -> IO s + } deriving (Functor) + +data BinaryWriter s = BinaryWriter + { putEntry :: WriteBinHandle -> s -> IO () + } + +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter f = BinaryWriter + { putEntry = f + } + +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s +mkReader f = BinaryReader + { getEntry = f + } + +findUserDataReader :: forall a . Typeable a => Proxy a -> ReadBinHandle -> BinaryReader a +findUserDataReader query bh = + case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of + Nothing -> panic $ "Failed to find BinaryReader for the key: " ++ show (typeRep query) + Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> + unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader + +findUserDataWriter :: forall a . Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a +findUserDataWriter query bh = + case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of + Nothing -> panic $ "Failed to find BinaryWriter for the key: " ++ show (typeRep query) + Just (SomeBinaryWriter _ (writer :: BinaryWriter x)) -> + unsafeCoerce @(BinaryWriter x) @(BinaryWriter a) writer + +noReaderUserData :: ReaderUserData +noReaderUserData = ReaderUserData + { ud_reader_data = Map.empty + } + +noWriterUserData :: WriterUserData +noWriterUserData = WriterUserData + { ud_writer_data = Map.empty + } + +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) + -> ReaderUserData +newReadState get_name get_fs = + mkReaderUserData + [ mkSomeBinaryReader $ mkReader get_name + , mkSomeBinaryReader $ mkReader @BindingName (coerce get_name) + , mkSomeBinaryReader $ mkReader get_fs + ] + +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize non-binding 'Name's - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) - -> UserData -newWriteState put_nonbinding_name put_binding_name put_fs - = UserData { ud_get_name = undef "get_name", - ud_get_fs = undef "get_fs", - ud_put_nonbinding_name = put_nonbinding_name, - ud_put_binding_name = put_binding_name, - ud_put_fs = put_fs - } - -noUserData :: UserData -noUserData = UserData - { ud_get_name = undef "get_name" - , ud_get_fs = undef "get_fs" - , ud_put_nonbinding_name = undef "put_nonbinding_name" - , ud_put_binding_name = undef "put_binding_name" - , ud_put_fs = undef "put_fs" + -> (WriteBinHandle -> FastString -> IO ()) + -> WriterUserData +newWriteState put_non_binding_name put_binding_name put_fs = + mkWriterUserData + [ mkSomeBinaryWriter $ mkWriter (\bh name -> put_binding_name bh (getBindingName name)) + , mkSomeBinaryWriter $ mkWriter put_non_binding_name + , mkSomeBinaryWriter $ mkWriter put_fs + ] + +-- ---------------------------------------------------------------------------- +-- Types for lookup and deduplication tables. +-- ---------------------------------------------------------------------------- + +data SomeReaderTable f = forall a . Typeable a => + SomeReaderTable (f (ReaderTable a)) + +data SomeWriterTable f = forall a . Typeable a => + SomeWriterTable (f (WriterTable, BinaryWriter a)) + +data ReaderTable a = ReaderTable + { getTable :: ReadBinHandle -> IO (SymbolTable a) + , mkReaderFromTable :: SymbolTable a -> BinaryReader a } -undef :: String -> a -undef s = panic ("Binary.UserData: no " ++ s) +data WriterTable = WriterTable + { putTable :: WriteBinHandle -> IO Int + } --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- -type Dictionary = Array Int FastString -- The dictionary - -- Should be 0-indexed +-- | A 'SymbolTable' of 'FastString's. +type Dictionary = SymbolTable FastString + +initFastStringReaderTable :: IO (ReaderTable FastString) +initFastStringReaderTable = do + return $ + ReaderTable + { getTable = getDictionary + , mkReaderFromTable = \tbl -> mkReader (getDictFastString tbl) + } + +initFastStringWriterTable :: IO (WriterTable, BinaryWriter FastString) +initFastStringWriterTable = do + dict_next_ref <- newFastMutInt 0 + dict_map_ref <- newIORef emptyUFM + let bin_dict = + FSTable + { fs_tab_next = dict_next_ref + , fs_tab_map = dict_map_ref + } + let put_dict bh = do + fs_count <- readFastMutInt dict_next_ref + dict_map <- readIORef dict_map_ref + putDictionary bh fs_count dict_map + pure fs_count -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () + return + ( WriterTable + { putTable = put_dict + } + , mkWriter $ putDictFastString bin_dict + ) + +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1156,34 +1356,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) - -initFSTable :: BinHandle -> IO (BinHandle, FSTable, IO Int) -initFSTable bh = do - dict_next_ref <- newFastMutInt 0 - dict_map_ref <- newIORef emptyUFM - let bin_dict = FSTable - { fs_tab_next = dict_next_ref - , fs_tab_map = dict_map_ref - } - let put_dict = do - fs_count <- readFastMutInt dict_next_ref - dict_map <- readIORef dict_map_ref - putDictionary bh fs_count dict_map - pure fs_count - - -- BinHandle with FastString writing support - let ud = getUserData bh - let ud_fs = ud { ud_put_fs = putDictFastString bin_dict } - let bh_fs = setUserData bh ud_fs - - return (bh_fs,bin_dict,put_dict) - -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1212,43 +1390,42 @@ data FSTable = FSTable { fs_tab_next :: !FastMutInt -- The next index to use -- The Symbol Table --------------------------------------------------------- --- On disk, the symbol table is an array of IfExtName, when --- reading it in we turn it into a SymbolTable. - -type SymbolTable = Array Int Name +-- | Symbols that are read from disk. +-- The 'SymbolTable' index starts on '0'. +type SymbolTable a = Array Int a --------------------------------------------------------- -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do @@ -1260,12 +1437,12 @@ instance Binary ByteString where instance Binary FastString where put_ bh f = - case getUserData bh of - UserData { ud_put_fs = put_fs } -> put_fs bh f + case findUserDataWriter (Proxy :: Proxy FastString) bh of + tbl -> putEntry tbl bh f get bh = - case getUserData bh of - UserData { ud_get_fs = get_fs } -> get_fs bh + case findUserDataReader (Proxy :: Proxy FastString) bh of + tbl -> getEntry tbl bh deriving instance Binary NonDetFastString deriving instance Binary LexicalFastString ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe +Subproject commit edf742131e272fc29c6d6eae549b0fe37eea11b9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e2705b08f39e87ccb4396739f0c67ef999e8d88...5935848a1121a97d202926eb41b202efcc3c7b5a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e2705b08f39e87ccb4396739f0c67ef999e8d88...5935848a1121a97d202926eb41b202efcc3c7b5a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 11:05:41 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 07:05:41 -0400 Subject: [Git][ghc/ghc][master] testsuite: Introduce template-haskell-exports test Message-ID: <660e898531409_15494c18bf2801163e2@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0fde229f by Ben Gamari at 2024-04-04T07:04:58-04:00 testsuite: Introduce template-haskell-exports test - - - - - 2 changed files: - testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/template-haskell-exports.stdout Changes: ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -9,3 +9,4 @@ def check_package(pkg_name): check_package('base') check_package('ghc-experimental') +check_package('template-haskell') ===================================== testsuite/tests/interface-stability/template-haskell-exports.stdout ===================================== The diff for this file was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fde229f1816a0f9a6f600df289b3d5d305eb0ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fde229f1816a0f9a6f600df289b3d5d305eb0ea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 11:06:13 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 07:06:13 -0400 Subject: [Git][ghc/ghc][master] Update correct counter in bumpTickyAllocd Message-ID: <660e89a59e464_15494c1a71b1412009e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0c4a9686 by Luite Stegeman at 2024-04-04T07:05:39-04:00 Update correct counter in bumpTickyAllocd - - - - - 1 changed file: - compiler/GHC/StgToCmm/Ticky.hs Changes: ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -809,7 +809,7 @@ bumpTickyEntryCount lbl = do bumpTickyAllocd :: CLabel -> Int -> FCode () bumpTickyAllocd lbl bytes = do platform <- getPlatform - bumpTickyLitBy (cmmLabelOffB lbl (pc_OFFSET_StgEntCounter_entry_count (platformConstants platform))) bytes + bumpTickyLitBy (cmmLabelOffB lbl (pc_OFFSET_StgEntCounter_allocd (platformConstants platform))) bytes bumpTickyTagSkip :: CLabel -> FCode () bumpTickyTagSkip lbl = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c4a96862081f03e2946a2ed7e80c108f06205a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c4a96862081f03e2946a2ed7e80c108f06205a1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 11:36:56 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 07:36:56 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: testsuite: Introduce template-haskell-exports test Message-ID: <660e90d8a3d3c_15494c1f355c4137634@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0fde229f by Ben Gamari at 2024-04-04T07:04:58-04:00 testsuite: Introduce template-haskell-exports test - - - - - 0c4a9686 by Luite Stegeman at 2024-04-04T07:05:39-04:00 Update correct counter in bumpTickyAllocd - - - - - 43914846 by Fendor at 2024-04-04T07:36:39-04:00 Avoid UArray when indexing is not required `UnlinkedBCO`'s can occur many times in the heap. Each `UnlinkedBCO` references two `UArray`'s but never indexes them. They are only needed to encode the elements into a `ByteArray#`. The three words for the lower bound, upper bound and number of elements are essentially unused, thus we replace `UArray` with a wrapper around `ByteArray#`. This saves us up to three words for each `UnlinkedBCO`. Further, to avoid re-allocating these words for `ResolvedBCO`, we repeat the procedure for `ResolvedBCO` and add custom `Binary` and `Show` instances. For example, agda's repl session has around 360_000 UnlinkedBCO's, so avoiding these three words is already saving us around 8MB residency. - - - - - 4aa55923 by Matthew Pickering at 2024-04-04T07:36:43-04:00 Fix off by one error in seekBinNoExpand and seekBin - - - - - 10 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Utils/Binary.hs - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/ResolvedBCO.hs - testsuite/tests/ghci/should_run/BinaryArray.hs - testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/template-haskell-exports.stdout Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -213,8 +213,8 @@ assembleBCO platform (ProtoBCO { protoBCOName = nm (text "bytecode instruction count mismatch") let asm_insns = ssElts final_insns - insns_arr = Array.listArray (0, fromIntegral n_insns - 1) asm_insns - bitmap_arr = mkBitmapArray bsize bitmap + !insns_arr = instrsFromUArray $ Array.listArray (0 :: Int, fromIntegral n_insns - 1) asm_insns + !bitmap_arr = bitmapFromUArray $ mkBitmapArray bsize bitmap ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr final_lits final_ptrs -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -42,9 +42,11 @@ import GHC.Types.Name.Env import Language.Haskell.Syntax.Module.Name -- Standard libraries +import Data.Array.Base (UArray(..)) import Data.Array.Unboxed import Foreign.Ptr import GHC.Exts +import Data.Word (Word64) {- Linking interpretables into something we can run @@ -60,10 +62,13 @@ linkBCO interp le bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - lits <- mapM (fmap fromIntegral . lookupLiteral interp le) (ssElts lits0) + (lits :: [Word64]) <- mapM (fmap fromIntegral . lookupLiteral interp le) (ssElts lits0) ptrs <- mapM (resolvePtr interp le bco_ix) (ssElts ptrs0) - return (ResolvedBCO isLittleEndian arity insns bitmap - (listArray (0, fromIntegral (sizeSS lits0)-1) lits) + let !(UArray _ _ _ lits') = listArray (0 :: Int, fromIntegral (sizeSS lits0)-1) lits + return (ResolvedBCO isLittleEndian arity + (BCOByteArray (getBCOInstrs insns)) + (BCOByteArray (getBCOBitmap bitmap)) + (BCOByteArray lits') (addListToSS emptySS ptrs)) lookupLiteral :: Interp -> LinkerEnv -> BCONPtr -> IO Word ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -1,6 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedNewtypes #-} -- -- (c) The University of Glasgow 2002-2006 -- @@ -8,6 +10,8 @@ -- | Bytecode assembler types module GHC.ByteCode.Types ( CompiledByteCode(..), seqCompiledByteCode + , BCOInstrs, getBCOInstrs, BCOBitmap, getBCOBitmap + , instrsFromUArray, bitmapFromUArray , FFIInfo(..) , RegBitmap(..) , NativeCallType(..), NativeCallInfo(..), voidTupleReturnInfo, voidPrimCallInfo @@ -36,7 +40,6 @@ import Control.DeepSeq import Foreign import Data.Array -import Data.Array.Base ( UArray(..) ) import Data.ByteString (ByteString) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap @@ -45,6 +48,9 @@ import GHC.Stack.CCS import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList ) import GHC.Iface.Syntax import Language.Haskell.Syntax.Module.Name (ModuleName) +import GHC.Base (ByteArray#) +import Data.Array.Unboxed (UArray) +import Data.Array.Base (UArray(..)) -- ----------------------------------------------------------------------------- -- Compiled Byte Code @@ -148,12 +154,26 @@ newtype ItblPtr = ItblPtr (RemotePtr Heap.StgInfoTable) newtype AddrPtr = AddrPtr (RemotePtr ()) deriving (NFData) +-- | 'BCOInstrs' is backed by an 'ByteArray#' and stores +-- 'Word16' elements. +newtype BCOInstrs = BCOInstrs { getBCOInstrs :: ByteArray# } + +-- | 'BCOBitmap' is backed by an 'ByteArray#' and stores +-- 'Word64' elements. +newtype BCOBitmap = BCOBitmap { getBCOBitmap :: ByteArray# } + +instrsFromUArray :: UArray Int Word16 -> BCOInstrs +instrsFromUArray !(UArray _ _ _ barr) = BCOInstrs barr + +bitmapFromUArray :: UArray Int Word64 -> BCOBitmap +bitmapFromUArray !(UArray _ _ _ barr) = BCOBitmap barr + data UnlinkedBCO = UnlinkedBCO { unlinkedBCOName :: !Name, unlinkedBCOArity :: {-# UNPACK #-} !Int, - unlinkedBCOInstrs :: !(UArray Int Word16), -- insns - unlinkedBCOBitmap :: !(UArray Int Word64), -- bitmap + unlinkedBCOInstrs :: !BCOInstrs, -- insns + unlinkedBCOBitmap :: !BCOBitmap, -- bitmap unlinkedBCOLits :: !(SizedSeq BCONPtr), -- non-ptrs unlinkedBCOPtrs :: !(SizedSeq BCOPtr) -- ptrs } ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -809,7 +809,7 @@ bumpTickyEntryCount lbl = do bumpTickyAllocd :: CLabel -> Int -> FCode () bumpTickyAllocd lbl bytes = do platform <- getPlatform - bumpTickyLitBy (cmmLabelOffB lbl (pc_OFFSET_StgEntCounter_entry_count (platformConstants platform))) bytes + bumpTickyLitBy (cmmLabelOffB lbl (pc_OFFSET_StgEntCounter_allocd (platformConstants platform))) bytes bumpTickyTagSkip :: CLabel -> FCode () bumpTickyTagSkip lbl = do ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -243,15 +243,18 @@ tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) seekBin :: BinHandle -> Bin a -> IO () seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r - if (p >= sz) + if (p > sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p --- | SeekBin but without calling expandBin +-- | 'seekBinNoExpand' moves the index pointer to the location pointed to +-- by 'Bin a'. +-- This operation may 'panic', if the pointer location is out of bounds of the +-- buffer of 'BinHandle'. seekBinNoExpand :: BinHandle -> Bin a -> IO () seekBinNoExpand (BinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r - if (p >= sz) + if (p > sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -68,9 +68,6 @@ createBCO arr bco return (HValue final_bco) } -toWordArray :: UArray Int Word64 -> UArray Int Word -toWordArray = amap fromIntegral - linkBCO' :: Array Int HValue -> ResolvedBCO -> IO BCO linkBCO' arr ResolvedBCO{..} = do let @@ -80,11 +77,10 @@ linkBCO' arr ResolvedBCO{..} = do !(I# arity#) = resolvedBCOArity !(EmptyArr empty#) = emptyArr -- See Note [BCO empty array] - - barr a = case a of UArray _lo _hi n b -> if n == 0 then empty# else b - insns_barr = barr resolvedBCOInstrs - bitmap_barr = barr (toWordArray resolvedBCOBitmap) - literals_barr = barr (toWordArray resolvedBCOLits) + barr arr# = if I# (sizeofByteArray# arr#) == 0 then empty# else arr# + insns_barr = barr (getBCOByteArray resolvedBCOInstrs) + bitmap_barr = barr (getBCOByteArray resolvedBCOBitmap) + literals_barr = barr (getBCOByteArray resolvedBCOLits) PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs IO $ \s -> ===================================== libraries/ghci/GHCi/ResolvedBCO.hs ===================================== @@ -1,9 +1,11 @@ {-# LANGUAGE RecordWildCards, DeriveGeneric, GeneralizedNewtypeDeriving, - BangPatterns, CPP #-} + BangPatterns, CPP, MagicHash, FlexibleInstances, FlexibleContexts, + TypeApplications, ScopedTypeVariables, UnboxedTuples #-} module GHCi.ResolvedBCO ( ResolvedBCO(..) , ResolvedBCOPtr(..) , isLittleEndian + , BCOByteArray(..) ) where import Prelude -- See note [Why do we import Prelude here?] @@ -11,11 +13,18 @@ import GHC.Data.SizedSeq import GHCi.RemoteTypes import GHCi.BreakArray -import Data.Array.Unboxed import Data.Binary +import Data.Binary.Put (putBuilder) import GHC.Generics -import GHCi.BinaryArray +import Foreign.Ptr +import Data.Array.Byte +import qualified Data.Binary.Get.Internal as Binary +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Builder.Internal as BB +import GHC.Exts + +import GHC.IO #include "MachDeps.h" @@ -32,19 +41,32 @@ isLittleEndian = True -- | A 'ResolvedBCO' is one in which all the 'Name' references have been -- resolved to actual addresses or 'RemoteHValues'. -- --- Note, all arrays are zero-indexed (we assume this when --- serializing/deserializing) data ResolvedBCO = ResolvedBCO { resolvedBCOIsLE :: Bool, resolvedBCOArity :: {-# UNPACK #-} !Int, - resolvedBCOInstrs :: UArray Int Word16, -- insns - resolvedBCOBitmap :: UArray Int Word64, -- bitmap - resolvedBCOLits :: UArray Int Word64, -- non-ptrs + resolvedBCOInstrs :: BCOByteArray Word16, -- insns + resolvedBCOBitmap :: BCOByteArray Word64, -- bitmap + resolvedBCOLits :: BCOByteArray Word64, -- non-ptrs resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr) -- ptrs } deriving (Generic, Show) +-- | Wrapper for a 'ByteArray#'. +-- The phantom type tells what elements are stored in the 'ByteArray#'. +-- Creating a 'ByteArray#' can be achieved using 'UArray''s API, +-- where the underlying 'ByteArray#' can be unpacked. +data BCOByteArray a + = BCOByteArray { + getBCOByteArray :: !ByteArray# + } + +instance Show (BCOByteArray Word16) where + showsPrec _ _ = showString "BCOByteArray Word16" + +instance Show (BCOByteArray Word64) where + showsPrec _ _ = showString "BCOByteArray Word64" + -- | The Binary instance for ResolvedBCOs. -- -- Note, that we do encode the endianness, however there is no support for mixed @@ -54,12 +76,16 @@ instance Binary ResolvedBCO where put ResolvedBCO{..} = do put resolvedBCOIsLE put resolvedBCOArity - putArray resolvedBCOInstrs - putArray resolvedBCOBitmap - putArray resolvedBCOLits + put resolvedBCOInstrs + put resolvedBCOBitmap + put resolvedBCOLits put resolvedBCOPtrs - get = ResolvedBCO - <$> get <*> get <*> getArray <*> getArray <*> getArray <*> get + get = ResolvedBCO <$> get <*> get <*> get <*> get <*> get <*> get + +instance Binary (BCOByteArray a) where + put = putBCOByteArray + get = decodeBCOByteArray + data ResolvedBCOPtr = ResolvedBCORef {-# UNPACK #-} !Int @@ -75,3 +101,65 @@ data ResolvedBCOPtr deriving (Generic, Show) instance Binary ResolvedBCOPtr + +-- -------------------------------------------------------- +-- Serialisers for 'BCOByteArray' +-- -------------------------------------------------------- + +putBCOByteArray :: BCOByteArray a -> Put +putBCOByteArray (BCOByteArray bar) = do + put (I# (sizeofByteArray# bar)) + putBuilder $ byteArrayBuilder bar + +decodeBCOByteArray :: Get (BCOByteArray a) +decodeBCOByteArray = do + n <- get + getByteArray n + +byteArrayBuilder :: ByteArray# -> BB.Builder +byteArrayBuilder arr# = BB.builder $ go 0 (I# (sizeofByteArray# arr#)) + where + go :: Int -> Int -> BB.BuildStep a -> BB.BuildStep a + go !inStart !inEnd k (BB.BufferRange outStart outEnd) + -- There is enough room in this output buffer to write all remaining array + -- contents + | inRemaining <= outRemaining = do + copyByteArrayToAddr arr# inStart outStart inRemaining + k (BB.BufferRange (outStart `plusPtr` inRemaining) outEnd) + -- There is only enough space for a fraction of the remaining contents + | otherwise = do + copyByteArrayToAddr arr# inStart outStart outRemaining + let !inStart' = inStart + outRemaining + return $! BB.bufferFull 1 outEnd (go inStart' inEnd k) + where + inRemaining = inEnd - inStart + outRemaining = outEnd `minusPtr` outStart + + copyByteArrayToAddr :: ByteArray# -> Int -> Ptr a -> Int -> IO () + copyByteArrayToAddr src# (I# src_off#) (Ptr dst#) (I# len#) = + IO $ \s -> case copyByteArrayToAddr# src# src_off# dst# len# s of + s' -> (# s', () #) + +getByteArray :: Int -> Get (BCOByteArray a) +getByteArray nbytes@(I# nbytes#) = do + let !(MutableByteArray arr#) = unsafeDupablePerformIO $ + IO $ \s -> case newByteArray# nbytes# s of + (# s', mbar #) -> (# s', MutableByteArray mbar #) + let go 0 _ = return () + go !remaining !off = do + Binary.readNWith n $ \ptr -> + copyAddrToByteArray ptr arr# off n + go (remaining - n) (off + n) + where n = min chunkSize remaining + go nbytes 0 + return $! unsafeDupablePerformIO $ + IO $ \s -> case unsafeFreezeByteArray# arr# s of + (# s', bar #) -> (# s', BCOByteArray bar #) + where + chunkSize = 10*1024 + + copyAddrToByteArray :: Ptr a -> MutableByteArray# RealWorld + -> Int -> Int -> IO () + copyAddrToByteArray (Ptr src#) dst# (I# dst_off#) (I# len#) = + IO $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of + s' -> (# s', () #) ===================================== testsuite/tests/ghci/should_run/BinaryArray.hs ===================================== @@ -1,11 +1,15 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts, MagicHash, ScopedTypeVariables #-} import Data.Binary.Get import Data.Binary.Put +import Data.Binary (get, put) +import Data.Array.Byte import Data.Array.Unboxed as AU import Data.Array.IO (IOUArray) import Data.Array.MArray (MArray) import Data.Array as A +import Data.Array.Base as A import GHCi.BinaryArray +import GHCi.ResolvedBCO import GHC.Word roundtripTest :: (IArray UArray a, MArray IOUArray a IO, Eq a) @@ -18,6 +22,17 @@ roundtripTest arr = | otherwise -> putStrLn "failed to round-trip" Left _ -> putStrLn "deserialization failed" +roundtripTestByteArray :: forall a . (IArray UArray a, MArray IOUArray a IO, Eq a) + => UArray Int a -> IO () +roundtripTestByteArray (UArray _ _ _ arr#) = + let val = BCOByteArray arr# :: BCOByteArray a + ser = Data.Binary.Put.runPut $ put val + in case Data.Binary.Get.runGetOrFail (get :: Get (BCOByteArray a)) ser of + Right (_, _, BCOByteArray arr'# ) + | ByteArray arr# == ByteArray arr'# -> return () + | otherwise -> putStrLn "failed to round-trip" + Left _ -> putStrLn "deserialization failed" + main :: IO () main = do roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Int) @@ -27,3 +42,10 @@ main = do roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word32) roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word64) roundtripTest (AU.listArray (1,500) ['a'..] :: UArray Int Char) + roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Int) + roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word) + roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word8) + roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word16) + roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word32) + roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word64) + roundtripTestByteArray (AU.listArray (1,500) ['a'..] :: UArray Int Char) ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -9,3 +9,4 @@ def check_package(pkg_name): check_package('base') check_package('ghc-experimental') +check_package('template-haskell') ===================================== testsuite/tests/interface-stability/template-haskell-exports.stdout ===================================== The diff for this file was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/329380e731bc3d455cc64f0c5a1f2463c39c11cb...4aa5592313aa35c977466c06c1ced79784419ff7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/329380e731bc3d455cc64f0c5a1f2463c39c11cb...4aa5592313aa35c977466c06c1ced79784419ff7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 12:39:23 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Thu, 04 Apr 2024 08:39:23 -0400 Subject: [Git][ghc/ghc][wip/fendor/fix-thunks-name-and-ui] Eliminate name thunk in declaration fingerprinting Message-ID: <660e9f7b4de00_1e95a0131a7860428@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/fix-thunks-name-and-ui at Glasgow Haskell Compiler / GHC Commits: e2de39aa by Fendor at 2024-04-04T14:39:16+02:00 Eliminate name thunk in declaration fingerprinting Thunk analysis showed that we have about 100_000 thunks (in agda and `-fwrite-simplified-core`) pointing to the name of the name decl. Forcing this thunk fixes this issue. - - - - - 1 changed file: - compiler/GHC/IfaceToCore.hs Changes: ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -956,7 +956,10 @@ tc_iface_decl_fingerprint :: Bool -- Don't load pragmas into tc_iface_decl_fingerprint ignore_prags (_version, decl) = do { -- Populate the name cache with final versions of all -- the names associated with the decl - let main_name = ifName decl + let !main_name = ifName decl + -- Thunk analysis showed we retain a lot of thunks here. + -- Thus, force it, it reduces the numbers of thunks in GHCi + -- session noticeably. -- Typecheck the thing, lazily -- NB. Firstly, the laziness is there in case we never need the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2de39aa82420a30ff04814adb65d28ddb787455 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2de39aa82420a30ff04814adb65d28ddb787455 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 12:47:27 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Thu, 04 Apr 2024 08:47:27 -0400 Subject: [Git][ghc/ghc][wip/nounpack-z-encs-faststring] Never UNPACK `FastMutInt` for counting z-encoded `FastString`s Message-ID: <660ea15fbd8e1_1e95a02a0e54638b6@gitlab.mail> Hannes Siebenhandl pushed to branch wip/nounpack-z-encs-faststring at Glasgow Haskell Compiler / GHC Commits: ce050190 by Fendor at 2024-04-04T14:47:20+02:00 Never UNPACK `FastMutInt` for counting z-encoded `FastString`s In `FastStringTable`, we count the number of z-encoded FastStrings that exist in a GHC session. We used to UNPACK the counters to not waste memory, but live retainer analysis showed that we allocate a lot of `FastMutInt`s, retained by `mkFastZString`. We lazily compute the `FastZString`, only incrementing the counter when the `FastZString` is forced. The function `mkFastStringWith` calls `mkZFastString` and boxes the `FastMutInt`, leading to the following core: mkFastStringWith = \ mk_fs _ -> = case stringTable of { FastStringTable _ n_zencs segments# _ -> ... case ((mk_fs (I# ...) (FastMutInt n_zencs)) `cast` <Co:2> :: ...) ... Marking this field as `NOUNPACK` avoids this reboxing, eliminating the allocation of a fresh `FastMutInt` on every `FastString` allocation. - - - - - 1 changed file: - compiler/GHC/Data/FastString.hs Changes: ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -304,9 +304,18 @@ and updates to multiple buckets with low synchronization overhead. See Note [Updating the FastString table] on how it's updated. -} data FastStringTable = FastStringTable - {-# UNPACK #-} !FastMutInt -- the unique ID counter shared with all buckets - {-# UNPACK #-} !FastMutInt -- number of computed z-encodings for all buckets - (Array# (IORef FastStringTableSegment)) -- concurrent segments + {-# UNPACK #-} !FastMutInt + -- ^ The unique ID counter shared with all buckets + -- + -- We unpack the 'FastMutInt' counter as it is always consumed strictly. + {-# NOUNPACK #-} !FastMutInt + -- ^ Number of computed z-encodings for all buckets. + -- + -- We mark this as 'NOUNPACK' as this 'FastMutInt' is retained by a thunk + -- in 'mkFastStringWith' and needs to be boxed any way. + -- If this is unpacked, then we box this single 'FastMutInt' once for each + -- allocated FastString. + (Array# (IORef FastStringTableSegment)) -- ^ concurrent segments data FastStringTableSegment = FastStringTableSegment {-# UNPACK #-} !(MVar ()) -- the lock for write in each segment View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce0501906e8dc90d485b6576a09920b29810b132 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce0501906e8dc90d485b6576a09920b29810b132 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 13:03:36 2024 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 04 Apr 2024 09:03:36 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/invis-pats-change-ast] 3 commits: testsuite: Introduce template-haskell-exports test Message-ID: <660ea52894902_1e95a0537b4074650@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/invis-pats-change-ast at Glasgow Haskell Compiler / GHC Commits: 0fde229f by Ben Gamari at 2024-04-04T07:04:58-04:00 testsuite: Introduce template-haskell-exports test - - - - - 0c4a9686 by Luite Stegeman at 2024-04-04T07:05:39-04:00 Update correct counter in bumpTickyAllocd - - - - - f3d4bfab by Andrei Borzenkov at 2024-04-04T17:03:21+04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Tc/Deriv/Functor.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 - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8fbc07b8ac00a88fd704f6d91ed4a25f7689e448...f3d4bfab295dfce962965c568ec42f8f3eb3bbb6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8fbc07b8ac00a88fd704f6d91ed4a25f7689e448...f3d4bfab295dfce962965c568ec42f8f3eb3bbb6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 13:20:43 2024 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 04 Apr 2024 09:20:43 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] MP fixes Message-ID: <660ea92b36154_1e95a093832084957@gitlab.mail> Matthew Pickering pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: 6a86d08b by Matthew Pickering at 2024-04-04T14:20:23+01:00 MP fixes - - - - - 3 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Types/FieldLabel.hs Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -168,7 +168,6 @@ getTables name_cache bh = do tables = [ SomeReaderTable initFastStringReaderTable , SomeReaderTable (initReadNameCachedBinary name_cache) - , SomeReaderTable @IO @BindingName (coerce (initReadNameCachedBinary name_cache)) ] tables <- traverse (\(SomeReaderTable tblM) -> tblM >>= pure . SomeReaderTable . pure) tables @@ -244,23 +243,16 @@ putWithTables bh' put_payload = do -- The order of these entries matters! -- -- See Note [Iface Binary Serialiser Order] for details. - writerTables = - [ SomeWriterTable initFastStringWriterTable - , SomeWriterTable initWriteNameTable - , SomeWriterTable (fmap (second (\(BinaryWriter f) -> BinaryWriter (\bh name -> f bh (getBindingName name)))) initWriteNameTable) - ] - tables <- traverse (\(SomeWriterTable worker) -> worker >>= pure . SomeWriterTable . pure) writerTables + (fast_wt, BinaryWriter fast_w) <- initFastStringWriterTable + (name_wt, BinaryWriter name_w) <- initWriteNameTable + - let writerUserData = - mkWriterUserData $ - map - (\(SomeWriterTable tbl') -> mkSomeBinaryWriter (snd $ runIdentity tbl')) - tables + let writerUserData = newWriteState name_w name_w fast_w let bh = setWriterUserData bh' writerUserData (fs_count : name_count : _, r) <- - putAllTables bh (fmap (\(SomeWriterTable tbl) -> fst $ runIdentity tbl) tables) $ do + putAllTables bh [fast_wt, name_wt] $ do put_payload bh return (name_count, fs_count, r) ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -120,11 +120,7 @@ type IfaceTopBndr = Name -- drop it when serialising and add it back in when deserialising. getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr -getIfaceTopBndr bh = - case findUserDataReader (Proxy @BindingName) bh of - tbl -> - --pprTrace "putIfaceTopBndr" (ppr name) $ - getBindingName <$> getEntry tbl bh +getIfaceTopBndr bh = get bh putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = ===================================== compiler/GHC/Types/FieldLabel.hs ===================================== @@ -140,14 +140,12 @@ instance Binary Name => Binary FieldLabel where put_ bh (FieldLabel aa ab ac) = do put_ bh aa put_ bh ab - case findUserDataWriter (Proxy @BindingName) bh of - tbl -> putEntry tbl bh (BindingName ac) + put_ bh ac get bh = do aa <- get bh ab <- get bh - ac <- case findUserDataReader (Proxy @BindingName) bh of - tbl -> getEntry tbl bh - return (FieldLabel aa ab $ getBindingName ac) + ac <- get bh + return (FieldLabel aa ab ac) flIsOverloaded :: FieldLabel -> Bool flIsOverloaded fl = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a86d08b4c20c3f05c0b5a959461815dd8604e15 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a86d08b4c20c3f05c0b5a959461815dd8604e15 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 13:28:07 2024 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 04 Apr 2024 09:28:07 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] MP fixes Message-ID: <660eaae79e81a_1e95a0aba68087054@gitlab.mail> Matthew Pickering pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: 61563853 by Matthew Pickering at 2024-04-04T14:27:54+01:00 MP fixes - - - - - 3 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Types/FieldLabel.hs Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -54,8 +54,6 @@ import Data.Word import Data.IORef import Control.Monad import Data.Functor.Identity -import Data.Bifunctor (Bifunctor(second)) -import Data.Coerce -- --------------------------------------------------------------------------- -- Reading and writing binary interface files @@ -168,7 +166,6 @@ getTables name_cache bh = do tables = [ SomeReaderTable initFastStringReaderTable , SomeReaderTable (initReadNameCachedBinary name_cache) - , SomeReaderTable @IO @BindingName (coerce (initReadNameCachedBinary name_cache)) ] tables <- traverse (\(SomeReaderTable tblM) -> tblM >>= pure . SomeReaderTable . pure) tables @@ -244,23 +241,16 @@ putWithTables bh' put_payload = do -- The order of these entries matters! -- -- See Note [Iface Binary Serialiser Order] for details. - writerTables = - [ SomeWriterTable initFastStringWriterTable - , SomeWriterTable initWriteNameTable - , SomeWriterTable (fmap (second (\(BinaryWriter f) -> BinaryWriter (\bh name -> f bh (getBindingName name)))) initWriteNameTable) - ] - tables <- traverse (\(SomeWriterTable worker) -> worker >>= pure . SomeWriterTable . pure) writerTables + (fast_wt, BinaryWriter fast_w) <- initFastStringWriterTable + (name_wt, BinaryWriter name_w) <- initWriteNameTable + - let writerUserData = - mkWriterUserData $ - map - (\(SomeWriterTable tbl') -> mkSomeBinaryWriter (snd $ runIdentity tbl')) - tables + let writerUserData = newWriteState name_w name_w fast_w let bh = setWriterUserData bh' writerUserData (fs_count : name_count : _, r) <- - putAllTables bh (fmap (\(SomeWriterTable tbl) -> fst $ runIdentity tbl) tables) $ do + putAllTables bh [fast_wt, name_wt] $ do put_payload bh return (name_count, fs_count, r) ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -120,11 +120,7 @@ type IfaceTopBndr = Name -- drop it when serialising and add it back in when deserialising. getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr -getIfaceTopBndr bh = - case findUserDataReader (Proxy @BindingName) bh of - tbl -> - --pprTrace "putIfaceTopBndr" (ppr name) $ - getBindingName <$> getEntry tbl bh +getIfaceTopBndr bh = get bh putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = ===================================== compiler/GHC/Types/FieldLabel.hs ===================================== @@ -140,14 +140,12 @@ instance Binary Name => Binary FieldLabel where put_ bh (FieldLabel aa ab ac) = do put_ bh aa put_ bh ab - case findUserDataWriter (Proxy @BindingName) bh of - tbl -> putEntry tbl bh (BindingName ac) + put_ bh ac get bh = do aa <- get bh ab <- get bh - ac <- case findUserDataReader (Proxy @BindingName) bh of - tbl -> getEntry tbl bh - return (FieldLabel aa ab $ getBindingName ac) + ac <- get bh + return (FieldLabel aa ab ac) flIsOverloaded :: FieldLabel -> Bool flIsOverloaded fl = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61563853ed31172db8efa2890b6929b467e1f826 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61563853ed31172db8efa2890b6929b467e1f826 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 15:54:28 2024 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 04 Apr 2024 11:54:28 -0400 Subject: [Git][ghc/ghc][wip/T23109] Wibbles Message-ID: <660ecd344dea6_1e95a01afcde0122560@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: b27f6c8c by Simon Peyton Jones at 2024-04-04T16:53:23+01:00 Wibbles Notably: define and use mkNewTypeDictApp - - - - - 5 changed files: - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Zonk/Type.hs Changes: ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -40,7 +40,6 @@ import GHC.Types.Var.Env ( VarEnv ) import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Var -import GHC.Types.Basic( dfunInlinePragma ) import GHC.Core.Predicate import GHC.Core.Coercion @@ -50,8 +49,7 @@ import GHC.Core.Make ( mkCharExpr, mkNaturalExpr, mkStringExprFS, mkCoreLams ) import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Core.Class -import GHC.Core.Unfold.Make( mkDFunUnfolding ) -import GHC.Core ( Expr(..), Bind(..), mkConApp ) +import GHC.Core ( Expr(..), mkConApp ) import GHC.StgToCmm.Closure ( isSmallFamily ) @@ -68,7 +66,6 @@ import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import GHC.Tc.Errors.Types import Control.Monad -import Data.Functor import Data.Maybe {- ******************************************************************* @@ -224,7 +221,6 @@ match_one so canonical dfun_id mb_inst_tys warn , iw_safe_over = so , iw_warn = warn } } } - {- Note [Shortcut solving: overlap] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we have @@ -255,13 +251,10 @@ was a puzzling example. matchCTuple :: Class -> [Type] -> TcM ClsInstResult matchCTuple clas tys -- (isCTupleClass clas) holds = return (OneInst { cir_new_theta = tys - , cir_mk_ev = tuple_ev + , cir_mk_ev = evDictApp clas tys , cir_canonical = True , cir_what = BuiltinInstance }) -- The dfun *is* the data constructor! - where - data_con = tyConSingleDataCon (classTyCon clas) - tuple_ev = evDFunApp (dataConWrapId data_con) tys {- ******************************************************************** * * @@ -413,36 +406,21 @@ makeLitDict clas lit_ty lit_expr , Just rep_tc <- tyConAppTyCon_maybe (classMethodTy meth) -- If the method type is forall n. KnownNat n => SNat n -- then rep_tc :: TyCon is SNat - , [dict_con] <- tyConDataCons (classTyCon clas) , [rep_con] <- tyConDataCons rep_tc - , let pred_ty = mkClassPred clas [lit_ty] - dict_args = [ Type lit_ty, mkConApp rep_con [Type lit_ty, lit_expr] ] - dfun_rhs = mkConApp dict_con dict_args - dfun_info = vanillaIdInfo `setUnfoldingInfo` mkDFunUnfolding [] dict_con dict_args - `setInlinePragInfo` dfunInlinePragma - dfun_occ_str :: String - = "$f" ++ occNameString (getOccName clas) ++ - occNameString (getDFunTyKey lit_ty) - - = do { df_name <- newName (mkVarOcc dfun_occ_str) - ; let dfun_id = mkLocalVar (DFunId True) df_name ManyTy pred_ty dfun_info - ev_tm = EvExpr (Let (NonRec dfun_id dfun_rhs) (Var dfun_id)) + = do { df_name <- newNTDFName clas + ; let mk_ev _ = mkNewTypeDictApp df_name clas [lit_ty] $ + mkConApp rep_con [Type lit_ty, lit_expr] ; return $ OneInst { cir_new_theta = [] - , cir_mk_ev = \_ -> ev_tm + , cir_mk_ev = mk_ev , cir_canonical = True , cir_what = BuiltinInstance } } - | otherwise - = pprPanic "makeLitDict" $ - text "Unexpected evidence for" <+> ppr (className clas) - $$ vcat (map (ppr . idType) (classMethods clas)) + | otherwise + = pprPanic "makeLitDict" $ + text "Unexpected evidence for" <+> ppr (className clas) + $$ vcat (map (ppr . idType) (classMethods clas)) + -{- Here is what we are making - let $dfKnownNat17 :: KnownNat 17 - [Unfolding = DFun :DKnownNat @17 (UnsafeSNat @17 17)] - $dfKnownNat17 = :DKnownNat @17 (UnsafeSNat @17 17) - in $dfKnownNat17 --} {- ******************************************************************** * * @@ -475,12 +453,10 @@ matchWithDict [cls, mty] `App` (Var sv `Cast` mkTransCo (mkSubCo co2) (mkSymCo co)) - ; tc <- tcLookupTyCon withDictClassName - ; let Just withdict_data_con - = tyConSingleDataCon_maybe tc -- "Data constructor" - -- for WithDict - mk_ev [c] = evDataConApp withdict_data_con - [cls, mty] [evWithDict (evTermCoercion (EvExpr c))] + ; wd_cls <- tcLookupClass withDictClassName + ; dfun_name <- newNTDFName wd_cls + ; let mk_ev [c] = mkNewTypeDictApp dfun_name wd_cls [cls, mty] $ + evWithDict (evTermCoercion (EvExpr c)) mk_ev e = pprPanic "matchWithDict" (ppr e) ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] @@ -949,21 +925,24 @@ matchDataToTag dataToTagClass [levity, dty] = do (mkNomReflCo ManyTy) (mkSymCo repCo) (mkReflCo Representational intPrimTy) - dataToTagDataCon = tyConSingleDataCon (classTyCon dataToTagClass) - mk_ev _ = evDataConApp dataToTagDataCon - [levity, dty] - [methodRep `Cast` methodCo] - -> addUsedDataCons rdr_env repTyCon -- See wrinkles DTW2 and DTW3 - $> OneInst { cir_new_theta = [] -- (Ignore stupid theta.) - , cir_mk_ev = mk_ev - , cir_canonical = True - , cir_what = BuiltinInstance - } + -> do { addUsedDataCons rdr_env repTyCon -- See wrinkles DTW2 and DTW3 + ; df_name <- newNTDFName dataToTagClass + ; let mk_ev _ = mkNewTypeDictApp df_name dataToTagClass [levity, dty] $ + methodRep `Cast` methodCo + ; pure (OneInst { cir_new_theta = [] -- (Ignore stupid theta.) + , cir_mk_ev = mk_ev + , cir_canonical = True + , cir_what = BuiltinInstance })} | otherwise -> pure NoInstance matchDataToTag _ _ = pure NoInstance +newNTDFName :: Class -> TcM Name +newNTDFName cls = newName (mkVarOcc dfun_occ_str) + where + dfun_occ_str :: String + dfun_occ_str = "$f" ++ occNameString (getOccName cls) {- ******************************************************************** * * @@ -1011,8 +990,8 @@ doFunTy clas ty mult arg_ty ret_ty , cir_what = BuiltinInstance } where preds = map (mk_typeable_pred clas) [mult, arg_ty, ret_ty] - mk_ev [mult_ev, arg_ev, ret_ev] = evTypeable ty $ - EvTypeableTrFun (EvExpr mult_ev) (EvExpr arg_ev) (EvExpr ret_ev) + mk_ev [mult_ev, arg_ev, ret_ev] + = evTypeable ty $ EvTypeableTrFun (EvExpr mult_ev) (EvExpr arg_ev) (EvExpr ret_ev) mk_ev _ = panic "GHC.Tc.Instance.Class.doFunTy" @@ -1164,21 +1143,21 @@ if you'd written ***********************************************************************-} -- See also Note [The equality types story] in GHC.Builtin.Types.Prim -matchEqualityInst :: Class -> [Type] -> (DataCon, Role, Type, Type) +matchEqualityInst :: Class -> [Type] -> (Role, Type, Type) -- Precondition: `cls` satisfies GHC.Core.Predicate.isEqualityClass -- See Note [Solving equality classes] in GHC.Tc.Solver.Dict matchEqualityInst cls args | cls `hasKey` eqTyConKey -- Solves (t1 ~ t2) , [_,t1,t2] <- args - = (eqDataCon, Nominal, t1, t2) + = (Nominal, t1, t2) | cls `hasKey` heqTyConKey -- Solves (t1 ~~ t2) , [_,_,t1,t2] <- args - = (heqDataCon, Nominal, t1, t2) + = (Nominal, t1, t2) | cls `hasKey` coercibleTyConKey -- Solves (Coercible t1 t2) , [_, t1, t2] <- args - = (coercibleDataCon, Representational, t1, t2) + = (Representational, t1, t2) | otherwise -- Does not satisfy the precondition = pprPanic "matchEqualityInst" (ppr (mkClassPred cls args)) ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -405,14 +405,14 @@ solveEqualityDict :: CtEvidence -> Class -> [Type] -> SolverStage Void solveEqualityDict ev cls tys | CtWanted { ctev_dest = dest } <- ev = Stage $ - do { let (data_con, role, t1, t2) = matchEqualityInst cls tys + do { let (role, t1, t2) = matchEqualityInst cls tys -- Unify t1~t2, putting anything that can't be solved -- immediately into the work list ; (co, _, _) <- wrapUnifierTcS ev role $ \uenv -> uType uenv t1 t2 -- Set d :: (t1~t2) = Eq# co ; setWantedEvTerm dest True $ - evDataConApp data_con tys [Coercion co] + evDictApp cls tys [Coercion co] ; stopWith ev "Solved wanted lifted equality" } | CtGiven { ctev_evar = ev_id, ctev_loc = loc } <- ev @@ -823,7 +823,7 @@ shortCutSolver dflags ev_w ev_i -- Emit work for subgoals but use our local cache -- so we can solve recursive dictionaries. - ; let ev_tm = mk_ev (map getEvExpr evc_vs) + ; let ev_tm = mk_ev (map getEvExpr evc_vs) ev_binds' = extendEvBinds ev_binds $ mkWantedEvBind (ctEvEvId ev) canonical ev_tm ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -202,15 +202,15 @@ mkProvEvidence ev_id hetero_tys = [k1, k2, ty1, ty2] = case r of ReprEq | is_homo - -> Just ( mkClassPred coercibleClass homo_tys - , evDataConApp coercibleDataCon homo_tys eq_con_args ) + -> Just ( mkClassPred coercibleClass homo_tys + , evDictApp coercibleClass homo_tys eq_con_args ) | otherwise -> Nothing NomEq | is_homo - -> Just ( mkClassPred eqClass homo_tys - , evDataConApp eqDataCon homo_tys eq_con_args ) + -> Just ( mkClassPred eqClass homo_tys + , evDictApp eqClass homo_tys eq_con_args ) | otherwise - -> Just ( mkClassPred heqClass hetero_tys - , evDataConApp heqDataCon hetero_tys eq_con_args ) + -> Just ( mkClassPred heqClass hetero_tys + , evDictApp heqClass hetero_tys eq_con_args ) | otherwise = Just (pred, EvExpr (evId ev_id)) ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Tc.Types.Evidence ( -- * EvTerm (already a CoreExpr) EvTerm(..), EvExpr, - evId, evCoercion, evCast, evDFunApp, evDataConApp, evSelector, + evId, evCoercion, evCast, evDFunApp, evDictApp, mkNewTypeDictApp, evSelector, mkEvCast, evVarsOfTerm, mkEvScSelectors, evTypeable, findNeededEvVars, evTermCoercion, evTermCoercion_maybe, @@ -50,27 +50,34 @@ module GHC.Tc.Types.Evidence ( import GHC.Prelude -import GHC.Types.Unique.DFM -import GHC.Types.Unique.FM -import GHC.Types.Var -import GHC.Types.Id( idScaledType ) +import GHC.Tc.Utils.TcType + +import GHC.Core import GHC.Core.Coercion.Axiom import GHC.Core.Coercion import GHC.Core.Ppr () -- Instance OutputableBndr TyVar -import GHC.Tc.Utils.TcType +import GHC.Core.Unfold.Make( mkDFunUnfolding ) import GHC.Core.Type import GHC.Core.TyCon -import GHC.Core.DataCon ( DataCon, dataConWrapId ) -import GHC.Builtin.Names +import GHC.Core.Class( classTyCon ) +import GHC.Core.DataCon ( isNewDataCon, dataConWrapId ) +import GHC.Core.Class (Class, classSCSelId ) +import GHC.Core.FVs ( exprSomeFreeVars ) +import GHC.Core.InstEnv ( Canonical ) + + +import GHC.Types.Unique.DFM +import GHC.Types.Unique.FM +import GHC.Types.Var +import GHC.Types.Id( idScaledType ) +import GHC.Types.Id.Info import GHC.Types.Var.Env import GHC.Types.Var.Set import GHC.Core.Predicate import GHC.Types.Basic +import GHC.Types.Name( Name ) -import GHC.Core -import GHC.Core.Class (Class, classSCSelId ) -import GHC.Core.FVs ( exprSomeFreeVars ) -import GHC.Core.InstEnv ( Canonical ) +import GHC.Builtin.Names import GHC.Utils.Misc import GHC.Utils.Panic @@ -529,8 +536,51 @@ evCast et tc | isReflCo tc = EvExpr et evDFunApp :: DFunId -> [Type] -> [EvExpr] -> EvTerm evDFunApp df tys ets = EvExpr $ Var df `mkTyApps` tys `mkApps` ets -evDataConApp :: DataCon -> [Type] -> [EvExpr] -> EvTerm -evDataConApp dc tys ets = evDFunApp (dataConWrapId dc) tys ets +evDictApp :: Class -> [Type] -> [EvExpr] -> EvTerm +-- Only for classes that are not represented by a newtype +evDictApp cls tys args + = case tyConSingleDataCon_maybe (classTyCon cls) of + Just dc -> assertPpr (not (isNewDataCon dc)) (ppr cls) $ + evDFunApp (dataConWrapId dc) tys args + Nothing -> pprPanic "evDictApp" (ppr cls) + +mkNewTypeDictApp :: Name -> Class -> [Type] -> EvExpr -> EvTerm +mkNewTypeDictApp df_name cls tys arg + | not (isNewTyCon tycon) + = evDictApp cls tys [arg] + | otherwise + = EvExpr $ Let (NonRec dfun dict_app) (Var dfun) + where + tycon = classTyCon cls + dict_con = tyConSingleDataCon tycon + pred_ty = mkClassPred cls tys + dict_args = map Type tys ++ [arg] + dict_app = mkConApp dict_con dict_args + dfun = mkLocalVar (DFunId True) df_name ManyTy pred_ty dfun_info + unf = mkDFunUnfolding [] dict_con dict_args + dfun_info = vanillaIdInfo `setUnfoldingInfo` unf + `setInlinePragInfo` dfunInlinePragma + +{- Here is what we are making: + let $fKnownNat :: KnownNat 17 + {-# Unfolding = DFun :DKnownNat @17 (UnsafeSNat @17 17) #-} + $fKnownNat = :DKnownNat @17 (UnsafeSNat @17 17) + in $fKnownNat + +Here we have introduced a funny extra binding: + +* KnownNat is a newtype class + +* $fKnownNat is a full DFun, with a DFun unfolding. So + - it does not inline; + - it interacts nicely with the class selector + +* :DKnowNat, the data construtor, will inline to a cast right away + But we don't want that to be visible to clients of this constraint + +All this is important for any newtype class; so evDictApp checks +that it is not used for newtype classes. +-} -- Selector id plus the types at which it -- should be instantiated, used for HasField ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -76,8 +76,8 @@ import GHC.Utils.Misc import GHC.Utils.Monad import GHC.Utils.Panic -import GHC.Core.Multiplicity import GHC.Core +import GHC.Core.Multiplicity import GHC.Core.Predicate import GHC.Types.Name @@ -597,7 +597,23 @@ zonkIdBndrX v zonkIdBndr :: TcId -> ZonkTcM Id zonkIdBndr v = do { Scaled w' ty' <- zonkScaledTcTypeToTypeX (idScaledType v) - ; return $ setIdMult (setIdType v ty') w' } + ; v' <- if isLocalId v && hasCoreUnfolding unf -- Local DFuns are like this + then do { unf' <- zonkUnfolding unf + ; return (setIdUnfolding v unf') } + else return v + ; return $ setIdMult (setIdType v' ty') w' } + where + unf = realIdUnfolding v + +zonkUnfolding :: Unfolding -> ZonkTcM Unfolding +zonkUnfolding unf@(CoreUnfolding { uf_tmpl = tmpl }) + = do { tmpl' <- zonkCoreExpr tmpl + ; return (unf { uf_tmpl = tmpl'}) } +zonkUnfolding unf@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) + = runZonkBndrT (zonkCoreBndrsX bndrs) $ \ bndrs' -> + do { args' <- mapM zonkCoreExpr args + ; return (unf { df_bndrs = bndrs', df_args = args'}) } +zonkUnfolding unf = return unf zonkIdBndrs :: [TcId] -> ZonkTcM [Id] zonkIdBndrs ids = mapM zonkIdBndr ids View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b27f6c8cc59bf576089c3c66ab0bed174aa65e6e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b27f6c8cc59bf576089c3c66ab0bed174aa65e6e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 16:14:13 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Thu, 04 Apr 2024 12:14:13 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] 2 commits: Refactor the Binary serialisation interface Message-ID: <660ed1d5660f3_1e95a01e540ec130115@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: a150e51a by Fendor at 2024-04-04T18:10:58+02:00 Refactor the Binary serialisation interface The end goal is to dynamically add deduplication tables for `ModIface` interface serialisation. We identify two main points of interest that make this difficult: 1. UserData hardcodes what `Binary` instances can have deduplication tables. Moreover, it heavily uses partial functions. 2. GHC.Iface.Binary hardcodes the deduplication tables for 'Name' and 'FastString', making it difficult to add more deduplication. Instead of having a single `UserData` record with fields for all the types that can have deduplication tables, we allow to provide custom serialisers for any `Typeable`. These are wrapped in existentials and stored in a `Map` indexed by their respective `TypeRep`. The `Binary` instance of the type to deduplicate still needs to explicitly look up the decoder via `findUserDataReader` and `findUserDataWriter`, which is no worse than the status-quo. `Map` was chosen as microbenchmarks indicate it is the fastest for a small number of keys (< 10). To generalise the deduplication table serialisation mechanism, we introduce the types `ReaderTable` and `WriterTable` which provide a simple interface that is sufficient to implement a general purpose deduplication mechanism for `writeBinIface` and `readBinIface`. This allows us to provide a list of deduplication tables for serialisation that can be extended more easily, for example for `IfaceTyCon`, see the issue https://gitlab.haskell.org/ghc/ghc/-/issues/24540 for more motivation. In addition to ths refactoring, we split `UserData` into `ReaderUserData` and `WriterUserData`, to avoid partial functions. Bump haddock submodule to accomodate for `UserData` split. - - - - - ea37b798 by Fendor at 2024-04-04T18:13:49+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 15 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -29,7 +29,6 @@ module GHC.Iface.Binary ( import GHC.Prelude -import GHC.Tc.Utils.Monad import GHC.Builtin.Utils ( isKnownKeyName, lookupKnownKeyName ) import GHC.Unit import GHC.Unit.Module.ModIface @@ -39,6 +38,7 @@ import GHC.Types.Unique.FM import GHC.Utils.Panic import GHC.Utils.Binary as Binary import GHC.Data.FastMutInt +import GHC.Data.FastString (FastString) import GHC.Types.Unique import GHC.Utils.Outputable import GHC.Types.Name.Cache @@ -75,7 +75,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -121,6 +121,8 @@ readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do pure (src_hash, bh) -- | Read an interface file. +-- +-- See Note [Iface Binary Serialisation] for details. readBinIface :: Profile -> NameCache @@ -135,7 +137,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -146,7 +148,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -154,24 +156,30 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do - -- Read the dictionary - -- The next word in the file is a pointer to where the dictionary is - -- (probably at the end of the file) - dict <- Binary.forwardGet bh (getDictionary bh) + fsReaderTable <- initFastStringReaderTable + nameReaderTable <- (initReadNameCachedBinary name_cache) + - -- Initialise the user-data field of bh - let bh_fs = setUserData bh $ newReadState (error "getSymtabName") - (getDictFastString dict) + -- The order of these deserialisation matters! + -- + -- See Note [Iface Binary Serialiser Order] for details. + fsTable <- Binary.forwardGet bh (getTable fsReaderTable bh) + let + fsReader = mkReaderFromTable fsReaderTable fsTable + bhFs = addReaderToUserData (mkSomeBinaryReader fsReader) bh - symtab <- Binary.forwardGet bh_fs (getSymbolTable bh_fs name_cache) + nameTable <- Binary.forwardGet bh (getTable nameReaderTable bhFs) + let + nameReader = mkReaderFromTable nameReaderTable nameTable + bhName = addReaderToUserData (mkSomeBinaryReader nameReader) bhFs - -- It is only now that we know how to get a Name - return $ setUserData bh $ newReadState (getSymtabName name_cache dict symtab) - (getDictFastString dict) + pure bhName --- | Write an interface file +-- | Write an interface file. +-- +-- See Note [Iface Binary Serialisation] for details. writeBinIface :: Profile -> TraceBinIFace -> FilePath -> ModIface -> IO () writeBinIface profile traceBinIface hi_path mod_iface = do bh <- openBinMem initBinMemSize @@ -184,14 +192,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -201,7 +209,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -225,43 +233,35 @@ putWithUserData traceBinIface bh payload = do -- -- It returns (number of names, number of FastStrings, payload write result) -- -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int,Int,b) -putWithTables bh put_payload = do - -- initialize state for the name table and the FastString table. - symtab_next <- newFastMutInt 0 - symtab_map <- newIORef emptyUFM - let bin_symtab = BinSymbolTable - { bin_symtab_next = symtab_next - , bin_symtab_map = symtab_map - } - - (bh_fs, bin_dict, put_dict) <- initFSTable bh - - (fs_count,(name_count,r)) <- forwardPut bh (const put_dict) $ do - - -- NB. write the dictionary after the symbol table, because - -- writing the symbol table may create more dictionary entries. - let put_symtab = do - name_count <- readFastMutInt symtab_next - symtab_map <- readIORef symtab_map - putSymbolTable bh_fs name_count symtab_map - pure name_count - - forwardPut bh_fs (const put_symtab) $ do - - -- BinHandle with FastString and Name writing support - let ud_fs = getUserData bh_fs - let ud_name = ud_fs - { ud_put_nonbinding_name = putName bin_dict bin_symtab - , ud_put_binding_name = putName bin_dict bin_symtab - } - let bh_name = setUserData bh ud_name - - put_payload bh_name - - return (name_count, fs_count, r) - - +-- See Note [Iface Binary Serialiser Order] +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) +putWithTables bh' put_payload = do + (fast_wt, fsWriter) <- initFastStringWriterTable + (name_wt, nameWriter) <- initWriteNameTable + + let writerUserData = mkWriterUserData + [ mkSomeBinaryWriter @FastString fsWriter + , mkSomeBinaryWriter @Name nameWriter + , mkSomeBinaryWriter @BindingName $ mkWriter (\bh name -> putEntry nameWriter bh (getBindingName name)) + ] + let bh = setWriterUserData bh' writerUserData + + (fs_count : name_count : _, r) <- + -- The order of these entries matters! + -- + -- See Note [Iface Binary Serialiser Order] for details. + putAllTables bh [fast_wt, name_wt] $ do + put_payload bh + + return (name_count, fs_count, r) + where + putAllTables _ [] act = do + a <- act + pure ([], a) + putAllTables bh (x : xs) act = do + (r, (res, a)) <- forwardPut bh (const $ putTable x bh) $ do + putAllTables bh xs act + pure (r : res, a) -- | Initial ram buffer to allocate for writing interface files initBinMemSize :: Int @@ -273,11 +273,108 @@ binaryInterfaceMagic platform | otherwise = FixedLengthEncoding 0x1face64 +{- +Note [Iface Binary Serialisation] +~~~~~~~~~~~~~~~~~~~ +When we serialise a 'ModIface', many symbols are redundant. +For example, there can be duplicated 'FastString's and 'Name's. +To save space, we deduplicate some symbols, such as 'FastString' and 'Name', +by maintaining a table of already seen symbols. +When serialising a symbol, we lookup whether we have encountered the symbol before. +If yes, we write the index of the symbol, otherwise we generate a new index and store it in the table. + +Besides saving a lot of disk space, this additionally enables us to automatically share +these symbols when we read the 'ModIface' from disk, without additional mechanisms such as 'FastStringTable'. + +Note [Iface Binary Serialiser Order] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Serialisation of 'ModIface' uses tables to deduplicate symbols that occur often. + +After 'ModIface' has been written to disk, we write the deduplication tables. +Writing a table may add additional entries to *other* deduplication tables, thus +we need to make sure that the symbol table we serialise only depends on +deduplication tables that haven't been written to disk yet. + +For example, assume we maintain deduplication tables for 'FastString' and 'Name'. +The symbol 'Name' depends on 'FastString', so serialising a 'Name' may add a 'FastString' +to the 'FastString' deduplication table. +Thus, 'Name' table needs to be serialised to disk before the 'FastString' table. + +When we read the 'ModIface' from disk, we consequentially need to read the 'FastString' +deduplication table from disk, before we can deserialise the 'Name' deduplication table. +Therefore, before we serialise the tables, we write forward pointers that allow us to jump ahead +to the table we need to deserialise first. + +Here, a visualisation of the table structure we currently have: + +┌──────────────┐ +│ Headers │ +├──────────────┤ +│ Ptr FS ├────────┐ +├──────────────┤ │ +│ Ptr Name ├─────┐ │ +├──────────────┤ │ │ +│ │ │ │ +│ ModIface │ │ │ +│ Payload │ │ │ +│ │ │ │ +├──────────────┤ │ │ +│ │ │ │ +│ Name Table │◄────┘ │ +│ │ │ +├──────────────┤ │ +│ │ │ +│ FS Table │◄───────┘ +│ │ +└──────────────┘ + +-} + + -- ----------------------------------------------------------------------------- -- The symbol table -- -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () + +initReadNameCachedBinary :: NameCache -> IO (ReaderTable Name) +initReadNameCachedBinary cache = do + return $ + ReaderTable + { getTable = \bh -> getSymbolTable bh cache + , mkReaderFromTable = \tbl -> mkReader (getSymtabName tbl) + } + +data BinSymbolTable = BinSymbolTable { + bin_symtab_next :: !FastMutInt, -- The next index to use + bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) + -- indexed by Name + } + +initWriteNameTable :: IO (WriterTable, BinaryWriter Name) +initWriteNameTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef emptyUFM + let bin_symtab = + BinSymbolTable + { bin_symtab_next = symtab_next + , bin_symtab_map = symtab_map + } + + let put_symtab bh = do + name_count <- readFastMutInt symtab_next + symtab_map <- readIORef symtab_map + putSymbolTable bh name_count symtab_map + pure name_count + + return + ( WriterTable + { putTable = put_symtab + } + , mkWriter $ putName bin_symtab + ) + + +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -286,7 +383,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -307,7 +404,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -331,8 +428,8 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: FSTable -> BinSymbolTable -> BinHandle -> Name -> IO () -putName _dict BinSymbolTable{ +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () +putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } bh name @@ -356,10 +453,9 @@ putName _dict BinSymbolTable{ put_ bh (fromIntegral off :: Word32) -- See Note [Symbol table representation of names] -getSymtabName :: NameCache - -> Dictionary -> SymbolTable - -> BinHandle -> IO Name -getSymtabName _name_cache _dict symtab bh = do +getSymtabName :: SymbolTable Name + -> ReadBinHandle -> IO Name +getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of 0x00000000 -> return $! symtab ! fromIntegral i @@ -376,10 +472,3 @@ getSymtabName _name_cache _dict symtab bh = do Just n -> n _ -> pprPanic "getSymtabName:unknown name tag" (ppr i) - -data BinSymbolTable = BinSymbolTable { - bin_symtab_next :: !FastMutInt, -- The next index to use - bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) - -- indexed by Name - } - ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -105,15 +105,16 @@ writeHieFile hie_file_path hiefile = do hie_dict_map = dict_map_ref } -- put the main thing - let bh = setUserData bh0 $ newWriteState (putName hie_symtab) - (putName hie_symtab) - (putFastString hie_dict) + let bh = setWriterUserData bh0 + $ newWriteState (putName hie_symtab) + (putName hie_symtab) + (putFastString hie_dict) put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next @@ -121,9 +122,9 @@ writeHieFile hie_file_path hiefile = do putSymbolTable bh symtab_next' symtab_map' -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -181,7 +182,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -190,7 +191,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -213,15 +214,16 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data bh1 <- do - let bh1 = setUserData bh0 $ newReadState (error "getSymtabName") - (getDictFastString dict) + let bh1 = setReaderUserData bh0 + $ newReadState (error "getSymtabName") + (getDictFastString dict) symtab <- get_symbol_table bh1 - let bh1' = setUserData bh1 + let bh1' = setReaderUserData bh1 $ newReadState (getSymTabName symtab) (getDictFastString dict) return bh1' @@ -231,21 +233,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -259,13 +261,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO SymbolTable +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -275,12 +277,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -333,7 +335,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -344,7 +346,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -1032,7 +1032,7 @@ addFingerprints hsc_env iface0 -- change if the fingerprint for anything it refers to (transitively) -- changes. mk_put_name :: OccEnv (OccName,Fingerprint) - -> BinHandle -> Name -> IO () + -> WriteBinHandle -> Name -> IO () mk_put_name local_env bh name | isWiredInName name = putNameLiterally bh name -- wired-in names don't have fingerprints ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -26,7 +26,7 @@ fingerprintBinMem bh = withBinBuffer bh f in fp `seq` return fp computeFingerprint :: (Binary a) - => (BinHandle -> Name -> IO ()) + => (WriteBinHandle -> Name -> IO ()) -> a -> IO Fingerprint computeFingerprint put_nonbinding_name a = do @@ -35,11 +35,11 @@ computeFingerprint put_nonbinding_name a = do fingerprintBinMem bh where set_user_data bh = - setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS + setWriterUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -31,7 +31,7 @@ import System.FilePath (normalise) -- NB: The 'Module' parameter is the 'Module' recorded by the *interface* -- file, not the actual 'Module' according to our 'DynFlags'. fingerprintDynFlags :: HscEnv -> Module - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintDynFlags hsc_env this_mod nameio = @@ -81,7 +81,7 @@ fingerprintDynFlags hsc_env this_mod nameio = -- object files as they can. -- See Note [Ignoring some flag changes] fingerprintOptFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintOptFlags DynFlags{..} nameio = let @@ -99,7 +99,7 @@ fingerprintOptFlags DynFlags{..} nameio = -- file compiled for HPC when not actually using HPC. -- See Note [Ignoring some flag changes] fingerprintHpcFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintHpcFlags dflags at DynFlags{..} nameio = let ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith, import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Proxy infixl 3 &&& @@ -118,15 +119,15 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = - case getUserData bh of - UserData{ ud_put_binding_name = put_binding_name } -> + case findUserDataWriter (Proxy @BindingName) bh of + tbl -> --pprTrace "putIfaceTopBndr" (ppr name) $ - put_binding_name bh name + putEntry tbl bh (BindingName name) data IfaceDecl @@ -2444,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -9,7 +9,6 @@ This module defines interface types and binders {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE LambdaCase #-} - module GHC.Iface.Type ( IfExtName, IfLclName, @@ -90,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ @@ -2045,11 +2044,12 @@ instance Outputable IfaceCoercion where ppr = pprIfaceCoercion instance Binary IfaceTyCon where - put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i + put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i - get bh = do n <- get bh - i <- get bh - return (IfaceTyCon n i) + get bh = do + n <- get bh + i <- get bh + return (IfaceTyCon n i) instance Binary IfaceTyConSort where put_ bh IfaceNormalTyCon = putByte bh 0 ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -66,6 +66,9 @@ import GHC.Prelude import Control.Monad import Data.Array +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import Data.Char (isSpace) import Data.Int import Data.IntSet (IntSet) import qualified Data.IntSet as IS @@ -75,10 +78,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Word import Data.Semigroup -import qualified Data.ByteString as B -import qualified Data.ByteString.Unsafe as B -import Data.Char (isSpace) -import System.IO +import System.IO import GHC.Settings.Constants (hiVersion) @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -313,15 +313,16 @@ putObject bh mod_name deps os = do -- object in an archive. put_ bh (moduleNameString mod_name) - (bh_fs, _bin_dict, put_dict) <- initFSTable bh + (fs_tbl, fs_writer) <- initFastStringWriterTable + let bh_fs = addWriterToUserData (mkSomeBinaryWriter fs_writer) bh - forwardPut_ bh (const put_dict) $ do + forwardPut_ bh (const (putTable fs_tbl bh_fs)) $ do put_ bh_fs deps -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -329,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -344,15 +345,15 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) - let bh = setUserData bh0 $ noUserData { ud_get_fs = getDictFastString dict } + let bh = setReaderUserData bh0 $ newReadState (panic "No name allowed") (getDictFastString dict) block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -363,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -392,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -408,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -778,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -1010,7 +1010,7 @@ data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple - deriving( Eq, Data ) + deriving( Eq, Data, Ord ) instance Outputable TupleSort where ppr ts = text $ ===================================== compiler/GHC/Types/FieldLabel.hs ===================================== @@ -140,9 +140,7 @@ instance Binary Name => Binary FieldLabel where put_ bh (FieldLabel aa ab ac) = do put_ bh aa put_ bh ab - case getUserData bh of - UserData{ ud_put_binding_name = put_binding_name } -> - put_binding_name bh ac + put_ bh ac get bh = do aa <- get bh ab <- get bh ===================================== compiler/GHC/Types/Name.hs ===================================== @@ -663,12 +663,12 @@ instance Data Name where -- distinction. instance Binary Name where put_ bh name = - case getUserData bh of - UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name + case findUserDataWriter Proxy bh of + tbl -> putEntry tbl bh name get bh = - case getUserData bh of - UserData { ud_get_name = get_name } -> get_name bh + case findUserDataReader Proxy bh of + tbl -> getEntry tbl bh {- ************************************************************************ ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -4,6 +4,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-} +{-# LANGUAGE TypeFamilies #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected @@ -21,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -30,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -66,15 +69,28 @@ module GHC.Utils.Binary lazyPutMaybe, -- * User data - UserData(..), getUserData, setUserData, - newReadState, newWriteState, noUserData, - + ReaderUserData(..), getReaderUserData, setReaderUserData, noReaderUserData, + WriterUserData(..), getWriterUserData, setWriterUserData, noWriterUserData, + mkWriterUserData, mkReaderUserData, + newReadState, newWriteState, + addReaderToUserData, addWriterToUserData, + findUserDataReader, findUserDataWriter, + -- * Binary Readers & Writers + BinaryReader(..), BinaryWriter(..), + mkWriter, mkReader, + SomeBinaryReader, SomeBinaryWriter, + mkSomeBinaryReader, mkSomeBinaryWriter, + -- * Tables + ReaderTable(..), + WriterTable(..), -- * String table ("dictionary") + initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, - FSTable, initFSTable, getDictFastString, putDictFastString, - + FSTable(..), getDictFastString, putDictFastString, -- * Newtype wrappers - BinSpan(..), BinSrcSpan(..), BinLocated(..) + BinSpan(..), BinSrcSpan(..), BinLocated(..), + -- * Newtypes for types that have canonically more than one valid encoding + BindingName(..), ) where import GHC.Prelude @@ -87,12 +103,14 @@ import GHC.Utils.Panic.Plain import GHC.Types.Unique.FM import GHC.Data.FastMutInt import GHC.Utils.Fingerprint +import GHC.Utils.Misc (HasCallStack) import GHC.Types.SrcLoc import GHC.Types.Unique import qualified GHC.Data.Strict as Strict import GHC.Utils.Outputable( JoinPointHood(..) ) import Control.DeepSeq +import Control.Monad ( when, (<$!>), unless, forM_, void ) import Foreign hiding (shiftL, shiftR, void) import Data.Array import Data.Array.IO @@ -104,11 +122,13 @@ import Data.IORef import Data.Char ( ord, chr ) import Data.List.NonEmpty ( NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Data.Set ( Set ) import qualified Data.Set as Set import Data.Time import Data.List (unfoldr) -import Control.Monad ( when, (<$!>), unless, forM_, void ) +import Data.Typeable import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Error ( mkIOError, eofErrorType ) @@ -119,6 +139,9 @@ import qualified Data.IntMap as IntMap import GHC.ForeignPtr ( unsafeWithForeignPtr ) #endif +import Unsafe.Coerce (unsafeCoerce) +import Data.Coerce + type BinArray = ForeignPtr Word8 #if !MIN_VERSION_base(4,15,0) @@ -150,49 +173,91 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_usr :: UserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: WriterUserData, + -- ^ User data for writing binary outputs. + -- Allows users to overwrite certain 'Binary' instances. + -- This is helpful when a non-canonical 'Binary' instance is required, + -- such as in the case of 'Name'. + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getUserData :: BinHandle -> UserData -getUserData bh = bh_usr bh +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: ReaderUserData, + -- ^ User data for reading binary inputs. + -- Allows users to overwrite certain 'Binary' instances. + -- This is helpful when a non-canonical 'Binary' instance is required, + -- such as in the case of 'Name'. + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) + } + +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh + +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setUserData :: BinHandle -> UserData -> BinHandle -setUserData bh us = bh { bh_usr = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } + +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } + +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle +addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) + } + } + +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle +addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) + } + } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -211,23 +276,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -235,42 +300,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } + +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p >= sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p >= sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -279,20 +359,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -313,7 +396,7 @@ expandBin (BinMem _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -329,7 +412,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -350,8 +433,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -372,39 +455,37 @@ putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -412,7 +493,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -425,7 +506,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -437,7 +518,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -458,10 +539,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -484,15 +565,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -509,15 +590,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -533,15 +614,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -561,15 +642,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -980,63 +1061,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1044,14 +1125,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1062,7 +1143,9 @@ lazyGetMaybe bh = do -- UserData -- ----------------------------------------------------------------------------- --- | Information we keep around during interface file +-- Note [Binary UserData] +-- ~~~~~~~~~~~~~~~~~~~~~~ +-- Information we keep around during interface file -- serialization/deserialization. Namely we keep the functions for serializing -- and deserializing 'Name's and 'FastString's. We do this because we actually -- use serialization in two distinct settings, @@ -1081,73 +1164,197 @@ lazyGetMaybe bh = do -- non-binding Name is serialized as the fingerprint of the thing they -- represent. See Note [Fingerprinting IfaceDecls] for further discussion. -- -data UserData = - UserData { - -- for *deserialising* only: - ud_get_name :: BinHandle -> IO Name, - ud_get_fs :: BinHandle -> IO FastString, - - -- for *serialising* only: - ud_put_nonbinding_name :: BinHandle -> Name -> IO (), - -- ^ serialize a non-binding 'Name' (e.g. a reference to another - -- binding). - ud_put_binding_name :: BinHandle -> Name -> IO (), - -- ^ serialize a binding 'Name' (e.g. the name of an IfaceDecl) - ud_put_fs :: BinHandle -> FastString -> IO () + +-- | Newtype to serialise binding names differently to non-binding 'Name'. +-- See Note [Binary UserData] +newtype BindingName = BindingName { getBindingName :: Name } + deriving ( Eq ) + +-- | Existential for 'BinaryWriter' with a type witness. +data SomeBinaryWriter = forall a . SomeBinaryWriter TypeRep (BinaryWriter a) + +-- | Existential for 'BinaryReader' with a type witness. +data SomeBinaryReader = forall a . SomeBinaryReader TypeRep (BinaryReader a) + +-- | UserData required to serialise symbols for interface files. +-- +-- See Note [Binary UserData] +data WriterUserData = + WriterUserData { + ud_writer_data :: Map TypeRep SomeBinaryWriter + -- ^ A mapping from a type witness to the 'Writer' for the associated type. + -- This is a 'Map' because microbenchmarks indicated this is more efficient + -- than other representations for less than ten elements. + -- + -- Considered representations: + -- + -- * [(TypeRep, SomeBinaryWriter)] + -- * bytehash (on hackage) + -- * Map TypeRep SomeBinaryWriter } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) - -> UserData -newReadState get_name get_fs - = UserData { ud_get_name = get_name, - ud_get_fs = get_fs, - ud_put_nonbinding_name = undef "put_nonbinding_name", - ud_put_binding_name = undef "put_binding_name", - ud_put_fs = undef "put_fs" - } - -newWriteState :: (BinHandle -> Name -> IO ()) +-- | UserData required to deserialise symbols for interface files. +-- +-- See Note [Binary UserData] +data ReaderUserData = + ReaderUserData { + ud_reader_data :: Map TypeRep SomeBinaryReader + -- ^ A mapping from a type witness to the 'Reader' for the associated type. + -- This is a 'Map' because microbenchmarks indicated this is more efficient + -- than other representations for less than ten elements. + -- + -- Considered representations: + -- + -- * [(TypeRep, SomeBinaryReader)] + -- * bytehash (on hackage) + -- * Map TypeRep SomeBinaryReader + } + +mkWriterUserData :: [SomeBinaryWriter] -> WriterUserData +mkWriterUserData caches = noWriterUserData + { ud_writer_data = Map.fromList $ map (\cache@(SomeBinaryWriter typRep _) -> (typRep, cache)) caches + } + +mkReaderUserData :: [SomeBinaryReader] -> ReaderUserData +mkReaderUserData caches = noReaderUserData + { ud_reader_data = Map.fromList $ map (\cache@(SomeBinaryReader typRep _) -> (typRep, cache)) caches + } + +mkSomeBinaryWriter :: forall a . Typeable a => BinaryWriter a -> SomeBinaryWriter +mkSomeBinaryWriter cb = SomeBinaryWriter (typeRep (Proxy :: Proxy a)) cb + +mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReader +mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb + +data BinaryReader s = BinaryReader + { getEntry :: ReadBinHandle -> IO s + } deriving (Functor) + +data BinaryWriter s = BinaryWriter + { putEntry :: WriteBinHandle -> s -> IO () + } + +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter f = BinaryWriter + { putEntry = f + } + +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s +mkReader f = BinaryReader + { getEntry = f + } + +-- | Find the 'BinaryReader' for the 'Binary' instance for the type identified by 'Proxy a'. +-- +-- If no 'BinaryReader' has been configured before, this function will panic. +findUserDataReader :: forall a . (HasCallStack, Typeable a) => Proxy a -> ReadBinHandle -> BinaryReader a +findUserDataReader query bh = + case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of + Nothing -> panic $ "Failed to find BinaryReader for the key: " ++ show (typeRep query) + Just (SomeBinaryReader _ (reader :: BinaryReader x)) -> + unsafeCoerce @(BinaryReader x) @(BinaryReader a) reader + +-- | Find the 'BinaryWriter' for the 'Binary' instance for the type identified by 'Proxy a'. +-- +-- If no 'BinaryWriter' has been configured before, this function will panic. +findUserDataWriter :: forall a . (HasCallStack, Typeable a) => Proxy a -> WriteBinHandle -> BinaryWriter a +findUserDataWriter query bh = + case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of + Nothing -> panic $ "Failed to find BinaryWriter for the key: " ++ show (typeRep query) + Just (SomeBinaryWriter _ (writer :: BinaryWriter x)) -> + unsafeCoerce @(BinaryWriter x) @(BinaryWriter a) writer + +noReaderUserData :: ReaderUserData +noReaderUserData = ReaderUserData + { ud_reader_data = Map.empty + } + +noWriterUserData :: WriterUserData +noWriterUserData = WriterUserData + { ud_writer_data = Map.empty + } + +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) + -> ReaderUserData +newReadState get_name get_fs = + mkReaderUserData + [ mkSomeBinaryReader $ mkReader get_name + , mkSomeBinaryReader $ mkReader @BindingName (coerce get_name) + , mkSomeBinaryReader $ mkReader get_fs + ] + +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize non-binding 'Name's - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) - -> UserData -newWriteState put_nonbinding_name put_binding_name put_fs - = UserData { ud_get_name = undef "get_name", - ud_get_fs = undef "get_fs", - ud_put_nonbinding_name = put_nonbinding_name, - ud_put_binding_name = put_binding_name, - ud_put_fs = put_fs - } - -noUserData :: UserData -noUserData = UserData - { ud_get_name = undef "get_name" - , ud_get_fs = undef "get_fs" - , ud_put_nonbinding_name = undef "put_nonbinding_name" - , ud_put_binding_name = undef "put_binding_name" - , ud_put_fs = undef "put_fs" + -> (WriteBinHandle -> FastString -> IO ()) + -> WriterUserData +newWriteState put_non_binding_name put_binding_name put_fs = + mkWriterUserData + [ mkSomeBinaryWriter $ mkWriter (\bh name -> put_binding_name bh (getBindingName name)) + , mkSomeBinaryWriter $ mkWriter put_non_binding_name + , mkSomeBinaryWriter $ mkWriter put_fs + ] + +-- ---------------------------------------------------------------------------- +-- Types for lookup and deduplication tables. +-- ---------------------------------------------------------------------------- + +data ReaderTable a = ReaderTable + { getTable :: ReadBinHandle -> IO (SymbolTable a) + , mkReaderFromTable :: SymbolTable a -> BinaryReader a } -undef :: String -> a -undef s = panic ("Binary.UserData: no " ++ s) +data WriterTable = WriterTable + { putTable :: WriteBinHandle -> IO Int + } --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- -type Dictionary = Array Int FastString -- The dictionary - -- Should be 0-indexed +-- | A 'SymbolTable' of 'FastString's. +type Dictionary = SymbolTable FastString -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +initFastStringReaderTable :: IO (ReaderTable FastString) +initFastStringReaderTable = do + return $ + ReaderTable + { getTable = getDictionary + , mkReaderFromTable = \tbl -> mkReader (getDictFastString tbl) + } + +initFastStringWriterTable :: IO (WriterTable, BinaryWriter FastString) +initFastStringWriterTable = do + dict_next_ref <- newFastMutInt 0 + dict_map_ref <- newIORef emptyUFM + let bin_dict = + FSTable + { fs_tab_next = dict_next_ref + , fs_tab_map = dict_map_ref + } + let put_dict bh = do + fs_count <- readFastMutInt dict_next_ref + dict_map <- readIORef dict_map_ref + putDictionary bh fs_count dict_map + pure fs_count + + return + ( WriterTable + { putTable = put_dict + } + , mkWriter $ putDictFastString bin_dict + ) + +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1156,34 +1363,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) - -initFSTable :: BinHandle -> IO (BinHandle, FSTable, IO Int) -initFSTable bh = do - dict_next_ref <- newFastMutInt 0 - dict_map_ref <- newIORef emptyUFM - let bin_dict = FSTable - { fs_tab_next = dict_next_ref - , fs_tab_map = dict_map_ref - } - let put_dict = do - fs_count <- readFastMutInt dict_next_ref - dict_map <- readIORef dict_map_ref - putDictionary bh fs_count dict_map - pure fs_count - - -- BinHandle with FastString writing support - let ud = getUserData bh - let ud_fs = ud { ud_put_fs = putDictFastString bin_dict } - let bh_fs = setUserData bh ud_fs - - return (bh_fs,bin_dict,put_dict) - -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1212,43 +1397,42 @@ data FSTable = FSTable { fs_tab_next :: !FastMutInt -- The next index to use -- The Symbol Table --------------------------------------------------------- --- On disk, the symbol table is an array of IfExtName, when --- reading it in we turn it into a SymbolTable. - -type SymbolTable = Array Int Name +-- | Symbols that are read from disk. +-- The 'SymbolTable' index starts on '0'. +type SymbolTable a = Array Int a --------------------------------------------------------- -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do @@ -1260,12 +1444,12 @@ instance Binary ByteString where instance Binary FastString where put_ bh f = - case getUserData bh of - UserData { ud_put_fs = put_fs } -> put_fs bh f + case findUserDataWriter (Proxy :: Proxy FastString) bh of + tbl -> putEntry tbl bh f get bh = - case getUserData bh of - UserData { ud_get_fs = get_fs } -> get_fs bh + case findUserDataReader (Proxy :: Proxy FastString) bh of + tbl -> getEntry tbl bh deriving instance Binary NonDetFastString deriving instance Binary LexicalFastString ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe +Subproject commit edf742131e272fc29c6d6eae549b0fe37eea11b9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61563853ed31172db8efa2890b6929b467e1f826...ea37b7989c13615069f728739afd871de7f9becb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61563853ed31172db8efa2890b6929b467e1f826...ea37b7989c13615069f728739afd871de7f9becb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 16:17:28 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 12:17:28 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Replace `SizedSeq` with `FlatBag` for flattened structure Message-ID: <660ed29899c5e_1e95a01fd49a81317d1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 27268b77 by Fendor at 2024-04-04T12:17:22-04:00 Replace `SizedSeq` with `FlatBag` for flattened structure LinkedLists are notoriously memory ineffiecient when all we do is traversing a structure. As 'UnlinkedBCO' has been identified as a data structure that impacts the overall memory usage of GHCi sessions, we avoid linked lists and prefer flattened structure for storing. We introduce a new memory efficient representation of sequential elements that has special support for the cases: * Empty * Singleton * Tuple Elements This improves sharing in the 'Empty' case and avoids the overhead of 'Array' until its constant overhead is justified. - - - - - ddc8afe9 by Fendor at 2024-04-04T12:17:22-04:00 Compact FlatBag array representation `Array` contains three additional `Word`'s we do not need in `FlatBag`. Move `FlatBag` to `SmallArray`. Expand the API of SmallArray by `sizeofSmallArray` and add common traversal functions, such as `mapSmallArray` and `foldMapSmallArray`. Additionally, allow users to force the elements of a `SmallArray` via `rnfSmallArray`. - - - - - 9d127769 by Andrei Borzenkov at 2024-04-04T12:17:23-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - fc649558 by Matthew Pickering at 2024-04-04T12:17:24-04:00 Fix off by one error in seekBinNoExpand and seekBin - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - + compiler/GHC/Data/FlatBag.hs - compiler/GHC/Data/SmallArray.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Functor.hs - compiler/GHC/Tc/Deriv/Generate.hs - 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/4aa5592313aa35c977466c06c1ced79784419ff7...fc6495586eeac7f975db9219a861119561c235ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4aa5592313aa35c977466c06c1ced79784419ff7...fc6495586eeac7f975db9219a861119561c235ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 16:22:48 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Thu, 04 Apr 2024 12:22:48 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` Message-ID: <660ed3d875e8a_1e95a0216987c139914@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: d07b4102 by Fendor at 2024-04-04T18:21:10+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 12 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -75,7 +75,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -137,7 +137,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinNoExpandReader bh extFields_p extFields <- get bh return mod_iface @@ -148,7 +148,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -156,7 +156,7 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do fsReaderTable <- initFastStringReaderTable nameReaderTable <- (initReadNameCachedBinary name_cache) @@ -192,14 +192,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -209,7 +209,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -234,7 +234,7 @@ putWithUserData traceBinIface bh payload = do -- It returns (number of names, number of FastStrings, payload write result) -- -- See Note [Iface Binary Serialiser Order] -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int, Int, b) +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) putWithTables bh' put_payload = do (fast_wt, fsWriter) <- initFastStringWriterTable (name_wt, nameWriter) <- initWriteNameTable @@ -374,7 +374,7 @@ initWriteNameTable = do ) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -383,7 +383,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -404,7 +404,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -428,7 +428,7 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: BinSymbolTable -> BinHandle -> Name -> IO () +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } @@ -454,7 +454,7 @@ putName BinSymbolTable{ -- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name - -> BinHandle -> IO Name + -> ReadBinHandle -> IO Name getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -112,9 +112,9 @@ writeHieFile hie_file_path hiefile = do put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next @@ -122,9 +122,9 @@ writeHieFile hie_file_path hiefile = do putSymbolTable bh symtab_next' symtab_map' -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -182,7 +182,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -191,7 +191,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -214,7 +214,7 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data @@ -233,21 +233,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinNoExpandReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinNoExpandReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinNoExpandReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinNoExpandReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -261,13 +261,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -277,12 +277,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable Name -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -335,7 +335,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -346,7 +346,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinNoExpandReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -1032,7 +1032,7 @@ addFingerprints hsc_env iface0 -- change if the fingerprint for anything it refers to (transitively) -- changes. mk_put_name :: OccEnv (OccName,Fingerprint) - -> BinHandle -> Name -> IO () + -> WriteBinHandle -> Name -> IO () mk_put_name local_env bh name | isWiredInName name = putNameLiterally bh name -- wired-in names don't have fingerprints ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -26,7 +26,7 @@ fingerprintBinMem bh = withBinBuffer bh f in fp `seq` return fp computeFingerprint :: (Binary a) - => (BinHandle -> Name -> IO ()) + => (WriteBinHandle -> Name -> IO ()) -> a -> IO Fingerprint computeFingerprint put_nonbinding_name a = do @@ -39,7 +39,7 @@ computeFingerprint put_nonbinding_name a = do -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -31,7 +31,7 @@ import System.FilePath (normalise) -- NB: The 'Module' parameter is the 'Module' recorded by the *interface* -- file, not the actual 'Module' according to our 'DynFlags'. fingerprintDynFlags :: HscEnv -> Module - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintDynFlags hsc_env this_mod nameio = @@ -81,7 +81,7 @@ fingerprintDynFlags hsc_env this_mod nameio = -- object files as they can. -- See Note [Ignoring some flag changes] fingerprintOptFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintOptFlags DynFlags{..} nameio = let @@ -99,7 +99,7 @@ fingerprintOptFlags DynFlags{..} nameio = -- file compiled for HPC when not actually using HPC. -- See Note [Ignoring some flag changes] fingerprintHpcFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintHpcFlags dflags at DynFlags{..} nameio = let ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -119,10 +119,10 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = case findUserDataWriter (Proxy @BindingName) bh of tbl -> @@ -2445,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -89,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq -import Control.Monad +import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -322,7 +322,7 @@ putObject bh mod_name deps os = do -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -330,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -345,7 +345,7 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) @@ -353,7 +353,7 @@ getObjectBody bh0 mod_name = do block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -364,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -393,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinNoExpandReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -409,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -779,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -31,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinNoExpandReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -85,7 +87,6 @@ module GHC.Utils.Binary initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, - -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..), -- * Newtypes for types that have canonically more than one valid encoding @@ -172,70 +173,91 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noReaderUserData noWriterUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_reader :: ReaderUserData, -- sigh, need parameterized modules :-) - bh_writer :: WriterUserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: WriterUserData, + -- ^ User data for writing binary outputs. + -- Allows users to overwrite certain 'Binary' instances. + -- This is helpful when a non-canonical 'Binary' instance is required, + -- such as in the case of 'Name'. + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) + } + +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: ReaderUserData, + -- ^ User data for reading binary inputs. + -- Allows users to overwrite certain 'Binary' instances. + -- This is helpful when a non-canonical 'Binary' instance is required, + -- such as in the case of 'Name'. + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getReaderUserData :: BinHandle -> ReaderUserData -getReaderUserData bh = bh_reader bh +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh -getWriterUserData :: BinHandle -> WriterUserData -getWriterUserData bh = bh_writer bh +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setWriterUserData :: BinHandle -> WriterUserData -> BinHandle -setWriterUserData bh us = bh { bh_writer = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } -setReaderUserData :: BinHandle -> ReaderUserData -> BinHandle -setReaderUserData bh us = bh { bh_reader = us } +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } -addReaderToUserData :: SomeBinaryReader -> BinHandle -> BinHandle +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh - { bh_reader = (bh_reader bh) - { ud_reader_data = Map.insert typRep cache (ud_reader_data (bh_reader bh)) + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) } } -addWriterToUserData :: SomeBinaryWriter -> BinHandle -> BinHandle +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh - { bh_writer = (bh_writer bh) - { ud_writer_data = Map.insert typRep cache (ud_writer_data (bh_writer bh)) + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) } } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -254,23 +276,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinNoExpandReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -278,42 +300,57 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } + +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r - if (p >= sz) + if (p > sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p -- | SeekBin but without calling expandBin -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r - if (p >= sz) + if (p > sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ _ ix_r _ arr_r) fn = do +-- | SeekBin but without calling expandBin +seekBinNoExpandReader :: ReadBinHandle -> Bin a -> IO () +seekBinNoExpandReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p > sz_r) + then panic "seekBinNoExpand: seek out of range" + else writeFastMutInt ix_r p + +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -322,20 +359,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -356,7 +396,7 @@ expandBin (BinMem _ _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -372,7 +412,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -393,8 +433,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -415,39 +455,37 @@ putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -455,7 +493,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -468,7 +506,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -480,7 +518,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -501,10 +539,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -527,15 +565,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -552,15 +590,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -576,15 +614,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -604,15 +642,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -1023,63 +1061,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinNoExpandReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinNoExpandReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinNoExpandReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1087,14 +1125,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1189,19 +1227,19 @@ mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReade mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb data BinaryReader s = BinaryReader - { getEntry :: BinHandle -> IO s + { getEntry :: ReadBinHandle -> IO s } deriving (Functor) data BinaryWriter s = BinaryWriter - { putEntry :: BinHandle -> s -> IO () + { putEntry :: WriteBinHandle -> s -> IO () } -mkWriter :: (BinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s mkWriter f = BinaryWriter { putEntry = f } -mkReader :: (BinHandle -> IO s) -> BinaryReader s +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s mkReader f = BinaryReader { getEntry = f } @@ -1209,7 +1247,7 @@ mkReader f = BinaryReader -- | Find the 'BinaryReader' for the 'Binary' instance for the type identified by 'Proxy a'. -- -- If no 'BinaryReader' has been configured before, this function will panic. -findUserDataReader :: forall a . (HasCallStack, Typeable a) => Proxy a -> BinHandle -> BinaryReader a +findUserDataReader :: forall a . (HasCallStack, Typeable a) => Proxy a -> ReadBinHandle -> BinaryReader a findUserDataReader query bh = case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of Nothing -> panic $ "Failed to find BinaryReader for the key: " ++ show (typeRep query) @@ -1219,7 +1257,7 @@ findUserDataReader query bh = -- | Find the 'BinaryWriter' for the 'Binary' instance for the type identified by 'Proxy a'. -- -- If no 'BinaryWriter' has been configured before, this function will panic. -findUserDataWriter :: forall a . (HasCallStack, Typeable a) => Proxy a -> BinHandle -> BinaryWriter a +findUserDataWriter :: forall a . (HasCallStack, Typeable a) => Proxy a -> WriteBinHandle -> BinaryWriter a findUserDataWriter query bh = case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of Nothing -> panic $ "Failed to find BinaryWriter for the key: " ++ show (typeRep query) @@ -1236,8 +1274,8 @@ noWriterUserData = WriterUserData { ud_writer_data = Map.empty } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) -> ReaderUserData newReadState get_name get_fs = mkReaderUserData @@ -1246,11 +1284,11 @@ newReadState get_name get_fs = , mkSomeBinaryReader $ mkReader get_fs ] -newWriteState :: (BinHandle -> Name -> IO ()) +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize non-binding 'Name's - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) + -> (WriteBinHandle -> FastString -> IO ()) -> WriterUserData newWriteState put_non_binding_name put_binding_name put_fs = mkWriterUserData @@ -1264,12 +1302,12 @@ newWriteState put_non_binding_name put_binding_name put_fs = -- ---------------------------------------------------------------------------- data ReaderTable a = ReaderTable - { getTable :: BinHandle -> IO (SymbolTable a) + { getTable :: ReadBinHandle -> IO (SymbolTable a) , mkReaderFromTable :: SymbolTable a -> BinaryReader a } data WriterTable = WriterTable - { putTable :: BinHandle -> IO Int + { putTable :: WriteBinHandle -> IO Int } --------------------------------------------------------- @@ -1309,14 +1347,14 @@ initFastStringWriterTable = do , mkWriter $ putDictFastString bin_dict ) -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1325,12 +1363,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1367,34 +1405,34 @@ type SymbolTable a = Array Int a -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit c641b7349239c497cbd64a64cd21fd388f431b9f +Subproject commit edf742131e272fc29c6d6eae549b0fe37eea11b9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d07b410229f3844118c4c211e9998478e0cdbc66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d07b410229f3844118c4c211e9998478e0cdbc66 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 16:26:24 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Thu, 04 Apr 2024 12:26:24 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] Make template-haskell a stage1 package Message-ID: <660ed4b0767f_1e95a0227f43c14035c@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: a5f0e63e by Teo Camarasu at 2024-04-04T17:25:59+01:00 Make template-haskell a stage1 package Promoting template-haskell from a stage0 to a stage1 package means that we can much more easily refactor template-haskell. In order to accomplish this we now compile stage0 packages using the boot compiler's version of template-haskell. This means that there are now two versions of template-haskell in play: the boot compiler's version, and the in-tree version. When compiling the stage1 compiler, we have to pick a version of template-haskell to use. During bootstrapping we want to use the same version as the final compiler. This forces the in-tree version. We are only able to use the internal interpreter with stage2 onwards. Yet, we could still use the external interpreter. The external interpreter runs splices in another process. Queries and results are seralised. This reduces our compatibility requirements from ABI compatibility with the internal interpreter to mere serialisation compatibility. We may compile GHC against another library to what the external interpreter is compiled against so long as it has exactly the same serialisation of template-haskell types. This opens up the strategy pursued in this patch. When compiling the stage1 compiler we vendor the template-haskell and ghc-boot-th libraries through ghc-boot and use these to define the Template Haskell interface for the external interpreter. Note that at this point we also have the template-haskell and ghc-boot-th packages in our transitive dependency closure from the boot compiler, and some packages like containers have dependencies on these to define Lift instances. Then the external interpreter should be compiled against the regular template-haskell library from the source tree. As this will have the same serialised interface as what we vendor in ghc-boot, we can then run splices. GHC stage2 is compiled as normal as well against the template-haskell library from the source tree. See Note [Bootstrapping Template Haskell] Resolves #23536 - - - - - 11 changed files: - compiler/GHC/Tc/Gen/Splice.hs - compiler/ghc.cabal.in - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs Changes: ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2916,3 +2916,106 @@ tcGetInterp = do case hsc_interp hsc_env of Nothing -> liftIO $ throwIO (InstallationError "Template haskell requires a target code interpreter") Just i -> pure i + +-- Note [Bootstrapping Template Haskell] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Template Haskell requires special attention when compiling GHC. +-- The implementation of the Template Haskell set of features requires tight +-- coupling between the compiler and the `template-haskell` library. +-- This complicates the bootstrapping story as compatibility constraints are +-- placed on the version of `template-haskell` used to compile GHC during a +-- particular stage and the version bundled with it. +-- +-- These constraints can be divided by the features they are used to implement, +-- namely running splices either directly or via the external interpreter, and +-- desugaring bracket syntax. +-- +-- (C1) Executing splices within the compiler: In order to execute a splice +-- within the compiler, we must be able to compile and load code built against +-- the same version of the `template-haskell` library as the compiler. This +-- is an ABI compatibility constraint between the `template-haskell` version of +-- the compiler and the splice. +-- (C2) Executing splices through the external interpreter: In order to execute +-- a splice via the external interpreter, we serialise bytecode, run it with the +-- external interpreter, and communicate back the result through a binary +-- serialised interface. This is a binary serialisation compatibilty constraint +-- between the `template-haskell` version of the compiler and the splice. +-- (C3) Desugaring bracket syntax: Bracket syntax is desugared by referring to a +-- special wired-in package whose package id is `template-haskell`. So for +-- instance an expression `'Just` gets desugared to something of type +-- `template-haskell:Language.Haskell.TH.Syntax.Name`. Importantly, while this +-- identifier is wired-in, the identity of the `template-haskell` package is +-- not. So for instance we can successfully use an expression like +-- `'Just :: Name` while compiling the `template-haskell` package as long as its +-- package id is set to `template-haskell` as `Name` will resolve the the local +-- identifier in the package (and the LHS and RHS will align). On the other +-- hand, if we don't set the special package id, the type of the expression will +-- be `template-haskell:...Name` while the `Name` on the RHS will resolve to the +-- local identifier and we will get a type error. So, bracket syntax assumes the +-- presence of a particular API in the `template-haskell` package, but it allows +-- +-- These constraints are ranked from strongest to weakest. They only apply if we +-- want to support the particular feature associated with them. +-- +-- The tricky case is what do to when building the bootstrapping (stage1) GHC. +-- The stage2 GHC is simpler as it can use the in-tree `template-haskell` +-- package built by the stage1 GHC. +-- +-- We should note that we cannot feasibly use the internal interpreter with a +-- stage1 GHC. This is because the stage1 GHC was compiled with the stage0 GHC, +-- which we assume is a different version. In order to run a splice that too +-- would need to be compiled with the stage0 GHC, and so would all its +-- dependencies. +-- This allows us to disregard (C1) for the stage1 case. +-- +-- In the past, we used to build the stage1 GHC and all its dependencies against +-- the in-tree `template-haskell` library. This meant that we sacrificed (C2) +-- because they are likely not serialisation compatible. We could not sacrifice +-- (C3) because dependencies of GHC (such as `containers` and +-- `template-haskell`) used bracket syntax to define `Lift` instances. This +-- meant that the interface assumed by the boot compiler to implement bracket +-- desugaring could not be modified (not even through CPP as (C1) would +-- constrain us in future stages where we do support the internal interpreter). +-- Yet, bracket syntax did work and gave us splices that desugared to code that +-- referenced the in-tree version of `template-haskell` not the one the boot +-- compiler required. So they could never be run. +-- +-- Our current strategy is to not build `template-haskell` as a stage0 package. +-- All of GHCs dependencies depend on the boot compilers version, and produce +-- runnable splices. How do we deal with the stage1 compiler's dependency on +-- `template-haskell`? There are two options. (D1) depend on the boot +-- compiler's version for stage1 and then depend on the in-tree one in stage2. +-- This violates (C1) and (C2), so we wouldn't be able to run splices at all +-- with the stage1 compiler. Additionally this would introduce quite a bit of +-- CPP into the compiler and mean we would have to stub out much of the +-- template-haskell machinery or have an unrunable compatibilty shim. Or (D2) +-- depend on the in-tree version. +-- +-- (D2) is what we implement, but it is complicated by the fact that it means we +-- practically have two versions of `template-haskell` in the dependency graph +-- of the stage1 compiler. To avoid this, we recall that we only need +-- serliasation compatibility (as per (C2)), so we can avoid a direct dependency +-- on the in-tree version by vendoring it. We choose to vendor it into the +-- `ghc-boot` package as both `lib:ghc` and `ghci` require a dependency on the +-- `template-haskell` interface as they define the two ends of the protocol. +-- This allows us to still run splices through the external interpreter. +-- +-- We should note a futher edge-case with this approach. When compiling our +-- vendored `template-haskell` library, we run afoul of (C3). The library +-- defines several `Name`s using bracket syntax. As this package doesn't claim +-- to be the wired-in package but it defines its own `Name` type, we get a type +-- discrepancy with the `Name` type from the boot compiler's `template-haskell` +-- library. Most of these are only used to define `Lift` instances, so in the +-- vendored case we simply hide them behind CPP. Yet, there is one distinct use +-- of a `Name`. We have a `Name` for the constructors of the `Multiplicity` +-- type, which are also used in the pretty-printing module. We construct these +-- manulally instead. This allows us to completely avoid using bracket syntax +-- for compiling the vendored `template-haskell` package. +-- +-- To summarise, our current approach allows us to use the external interpreter +-- to run splices and allows bracket syntax to be desugared correctly. In order +-- to implement this we vendor the `template-haskell` library into `ghc-boot` +-- and take special care to not use bracket syntax in those modules as that +-- would incorrectly produce code that uses identifiers from the boot compiler's +-- `template-haskell` library. ===================================== compiler/ghc.cabal.in ===================================== @@ -115,7 +115,6 @@ Library containers >= 0.6.2.1 && < 0.8, array >= 0.1 && < 0.6, filepath >= 1 && < 1.6, - template-haskell == 2.22.*, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -35,7 +35,10 @@ extra_dependencies = where th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") - dep (p1, m1) (p2, m2) s = do + dep (p1, m1) (p2, m2) s = + -- We use the boot compiler's `template-haskell` library when building stage0, + -- so we don't need to register dependencies. + if isStage0 s then pure [] else do let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set") ways <- interpretInContext context getLibraryWays mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways) ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,7 +158,6 @@ toolTargets = [ binary -- , ghc -- # depends on ghc library -- , runGhc -- # depends on ghc library , ghcBoot - , ghcBootTh , ghcPlatform , ghcToolchain , ghcToolchainBin @@ -172,7 +171,6 @@ toolTargets = [ binary , mtl , parsec , time - , templateHaskell , text , transformers , semaphoreCompat ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -93,7 +93,6 @@ stage0Packages = do , ghc , runGhc , ghcBoot - , ghcBootTh , ghcPlatform , ghcHeap , ghcToolchain @@ -108,7 +107,6 @@ stage0Packages = do , parsec , semaphoreCompat , time - , templateHaskell , text , transformers , unlit @@ -143,6 +141,7 @@ stage1Packages = do , deepseq , exceptions , ghc + , ghcBootTh , ghcBignum , ghcCompact , ghcExperimental @@ -156,6 +155,7 @@ stage1Packages = do , pretty , rts , semaphoreCompat + , templateHaskell , stm , unlit , xhtml ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -121,6 +121,10 @@ packageArgs = do , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ? input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ] + -------------------------------- ghcBoot ------------------------------ + , package ghcBoot ? + builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap-th") + --------------------------------- ghci --------------------------------- , package ghci ? mconcat [ ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -35,6 +35,15 @@ source-repository head location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/ghc-boot +Flag bootstrap-th + Description: + Enabled when building the stage1 compiler in order to vendor the in-tree + `template-haskell` library, while allowing dependencies to depend on the + boot `template-haskell` library. + See Note [Bootstrapping Template Haskell] + Default: False + Manual: True + Library default-language: Haskell2010 other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables @@ -56,13 +65,6 @@ Library GHC.UniqueSubdir GHC.Version - -- reexport modules from ghc-boot-th so that packages don't have to import - -- both ghc-boot and ghc-boot-th. It makes the dependency graph easier to - -- understand and to refactor. - reexported-modules: - GHC.LanguageExtensions.Type - , GHC.ForeignSrcLang.Type - , GHC.Lexeme -- reexport platform modules from ghc-platform reexported-modules: @@ -81,7 +83,49 @@ Library filepath >= 1.3 && < 1.6, deepseq >= 1.4 && < 1.6, ghc-platform >= 0.1, - ghc-boot-th == @ProjectVersionMunged@ + if flag(bootstrap-th) + cpp-options: -DBOOTSTRAP_TH + build-depends: + ghc-prim + , pretty + -- we vendor ghc-boot-th and template-haskell while bootstrapping TH. + -- This is to avoid having two copies of ghc-boot-th and template-haskell + -- in the build graph: one from the boot compiler and the in-tree one. + hs-source-dirs: . ../ghc-boot-th ../template-haskell ../template-haskell/vendored-filepath + exposed-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Lib + , Language.Haskell.TH.Ppr + , Language.Haskell.TH.PprLib + , Language.Haskell.TH.Quote + , Language.Haskell.TH.Syntax + , Language.Haskell.TH.LanguageExtensions + , Language.Haskell.TH.CodeDo + , Language.Haskell.TH.Lib.Internal + + other-modules: + Language.Haskell.TH.Lib.Map + , System.FilePath + , System.FilePath.Posix + , System.FilePath.Windows + else + hs-source-dirs: . + build-depends: + ghc-boot-th == @ProjectVersionMunged@ + , template-haskell == 2.22.0.0 + -- reexport modules from ghc-boot-th and template-haskell so that packages + -- don't have to import all of ghc-boot, ghc-boot-th and template-haskell. + -- It makes the dependency graph easier to understand and to refactor + -- and reduces the amount of cabal flags we need to use for bootstrapping TH. + reexported-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Syntax if !os(windows) build-depends: unix >= 2.7 && < 2.9 ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -84,7 +84,6 @@ library filepath >= 1.4 && < 1.6, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, - template-haskell == 2.22.*, transformers >= 0.5 && < 0.7 if !os(windows) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -34,49 +34,54 @@ module Language.Haskell.TH.Syntax -- $infix ) where -import qualified Data.Fixed as Fixed +import Prelude import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import System.FilePath import GHC.IO.Unsafe ( unsafeDupableInterleaveIO ) -import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Fix (MonadFix (..)) -import Control.Applicative (Applicative(..)) import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO) import Control.Exception.Base (FixIOException (..)) import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar) import System.IO ( hPutStrLn, stderr ) -import Data.Char ( isAlpha, isAlphaNum, isUpper, ord ) +import Data.Char ( isAlpha, isAlphaNum, isUpper ) import Data.Int import Data.List.NonEmpty ( NonEmpty(..) ) -import Data.Void ( Void, absurd ) import Data.Word import Data.Ratio -import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) -import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), - TYPE, RuntimeRep(..), Levity(..), 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 ) import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions -import Numeric.Natural import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types +#ifdef BOOTSTRAP_TH +import GHC.Types (TYPE, RuntimeRep(..), Levity(..)) +#else +import Control.Monad (liftM) +import Data.Char (ord) +import qualified Data.Fixed as Fixed +import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) +import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), + TYPE, RuntimeRep(..), Levity(..) ) +import GHC.CString ( unpackCString# ) +import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) +import Data.Void ( Void, absurd ) +import Numeric.Natural import Data.Array.Byte (ByteArray(..)) import GHC.Exts ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray# , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents# , copyByteArray#, newPinnedByteArray#) -import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) import GHC.ST (ST(..), runST) +#endif ----------------------------------------------------- -- @@ -1018,6 +1023,8 @@ class Lift (t :: TYPE r) where liftTyped :: Quote m => t -> Code m t +-- See Note [Bootstrapping Template Haskell] +#ifndef BOOTSTRAP_TH -- If you add any instances here, consider updating test th/TH_Lift instance Lift Integer where liftTyped x = unsafeCodeCoerce (lift x) @@ -1384,10 +1391,11 @@ rightName = 'Right nonemptyName :: Name nonemptyName = '(:|) +#endif oneName, manyName :: Name -oneName = 'One -manyName = 'Many +oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" +manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" ----------------------------------------------------- -- ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Posix ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Windows ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5f0e63ee2bec8bf895c24434d513a2684e95192 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5f0e63ee2bec8bf895c24434d513a2684e95192 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 16:29:19 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Thu, 04 Apr 2024 12:29:19 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] Make template-haskell a stage1 package Message-ID: <660ed55feabbf_1e95a023ce798144512@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: 7c85b3d8 by Teo Camarasu at 2024-04-04T17:29:07+01:00 Make template-haskell a stage1 package Promoting template-haskell from a stage0 to a stage1 package means that we can much more easily refactor template-haskell. In order to accomplish this we now compile stage0 packages using the boot compiler's version of template-haskell. This means that there are now two versions of template-haskell in play: the boot compiler's version, and the in-tree version. When compiling the stage1 compiler, we have to pick a version of template-haskell to use. During bootstrapping we want to use the same version as the final compiler. This forces the in-tree version. We are only able to use the internal interpreter with stage2 onwards. Yet, we could still use the external interpreter. The external interpreter runs splices in another process. Queries and results are seralised. This reduces our compatibility requirements from ABI compatibility with the internal interpreter to mere serialisation compatibility. We may compile GHC against another library to what the external interpreter is compiled against so long as it has exactly the same serialisation of template-haskell types. This opens up the strategy pursued in this patch. When compiling the stage1 compiler we vendor the template-haskell and ghc-boot-th libraries through ghc-boot and use these to define the Template Haskell interface for the external interpreter. Note that at this point we also have the template-haskell and ghc-boot-th packages in our transitive dependency closure from the boot compiler, and some packages like containers have dependencies on these to define Lift instances. Then the external interpreter should be compiled against the regular template-haskell library from the source tree. As this will have the same serialised interface as what we vendor in ghc-boot, we can then run splices. GHC stage2 is compiled as normal as well against the template-haskell library from the source tree. See Note [Bootstrapping Template Haskell] Resolves #23536 - - - - - 11 changed files: - compiler/GHC/Tc/Gen/Splice.hs - compiler/ghc.cabal.in - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs Changes: ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2916,3 +2916,108 @@ tcGetInterp = do case hsc_interp hsc_env of Nothing -> liftIO $ throwIO (InstallationError "Template haskell requires a target code interpreter") Just i -> pure i + +-- Note [Bootstrapping Template Haskell] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Template Haskell requires special attention when compiling GHC. +-- The implementation of the Template Haskell set of features requires tight +-- coupling between the compiler and the `template-haskell` library. +-- This complicates the bootstrapping story as compatibility constraints are +-- placed on the version of `template-haskell` used to compile GHC during a +-- particular stage and the version bundled with it. +-- +-- These constraints can be divided by the features they are used to implement, +-- namely running splices either directly or via the external interpreter, and +-- desugaring bracket syntax. +-- +-- (C1) Executing splices within the compiler: In order to execute a splice +-- within the compiler, we must be able to compile and load code built against +-- the same version of the `template-haskell` library as the compiler. This +-- is an ABI compatibility constraint between the `template-haskell` version of +-- the compiler and the splice. +-- (C2) Executing splices through the external interpreter: In order to execute +-- a splice via the external interpreter, we serialise bytecode, run it with the +-- external interpreter, and communicate back the result through a binary +-- serialised interface. This is a binary serialisation compatibilty constraint +-- between the `template-haskell` version of the compiler and the splice. +-- (C3) Desugaring bracket syntax: Bracket syntax is desugared by referring to a +-- special wired-in package whose package id is `template-haskell`. So for +-- instance an expression `'Just` gets desugared to something of type +-- `template-haskell:Language.Haskell.TH.Syntax.Name`. Importantly, while this +-- identifier is wired-in, the identity of the `template-haskell` package is +-- not. So for instance we can successfully use an expression like +-- `'Just :: Name` while compiling the `template-haskell` package as long as its +-- package id is set to `template-haskell` as `Name` will resolve the the local +-- identifier in the package (and the LHS and RHS will align). On the other +-- hand, if we don't set the special package id, the type of the expression will +-- be `template-haskell:...Name` while the `Name` on the RHS will resolve to the +-- local identifier and we will get a type error. So, bracket syntax assumes the +-- presence of a particular API in the `template-haskell` package, but it allows +-- +-- These constraints are ranked from strongest to weakest. They only apply if we +-- want to support the particular feature associated with them. +-- +-- The tricky case is what do to when building the bootstrapping (stage1) GHC. +-- The stage2 GHC is simpler as it can use the in-tree `template-haskell` +-- package built by the stage1 GHC. +-- +-- We should note that we cannot feasibly use the internal interpreter with a +-- stage1 GHC. This is because the stage1 GHC was compiled with the stage0 GHC, +-- which we assume is a different version. In order to run a splice that too +-- would need to be compiled with the stage0 GHC, and so would all its +-- dependencies. +-- This allows us to disregard (C1) for the stage1 case. +-- +-- In the past, we used to build the stage1 GHC and all its dependencies against +-- the in-tree `template-haskell` library. This meant that we sacrificed (C2) +-- because they are likely not serialisation compatible. We could not sacrifice +-- (C3) because dependencies of GHC (such as `containers` and +-- `template-haskell`) used bracket syntax to define `Lift` instances. This +-- meant that the interface assumed by the boot compiler to implement bracket +-- desugaring could not be modified (not even through CPP as (C1) would +-- constrain us in future stages where we do support the internal interpreter). +-- Yet, bracket syntax did work and gave us splices that desugared to code that +-- referenced the in-tree version of `template-haskell` not the one the boot +-- compiler required. So they could never be run. +-- +-- Our current strategy is to not build `template-haskell` as a stage0 package. +-- All of GHCs dependencies depend on the boot compilers version, and produce +-- runnable splices. How do we deal with the stage1 compiler's dependency on +-- `template-haskell`? There are two options. (D1) depend on the boot +-- compiler's version for stage1 and then depend on the in-tree one in stage2. +-- This violates (C1) and (C2), so we wouldn't be able to run splices at all +-- with the stage1 compiler. Additionally this would introduce quite a bit of +-- CPP into the compiler and mean we would have to stub out much of the +-- template-haskell machinery or have an unrunable compatibilty shim. Or (D2) +-- depend on the in-tree version. +-- +-- (D2) is what we implement, but it is complicated by the fact that it means we +-- practically have two versions of `template-haskell` in the dependency graph +-- of the stage1 compiler. To avoid this, we recall that we only need +-- serliasation compatibility (as per (C2)), so we can avoid a direct dependency +-- on the in-tree version by vendoring it. We choose to vendor it into the +-- `ghc-boot` package as both `lib:ghc` and `ghci` require a dependency on the +-- `template-haskell` interface as they define the two ends of the protocol. +-- This allows us to still run splices through the external interpreter. +-- +-- We should note a futher edge-case with this approach. When compiling our +-- vendored `template-haskell` library, we run afoul of (C3). The library +-- defines several `Name`s using bracket syntax. As this package doesn't claim +-- to be the wired-in package but it defines its own `Name` type, we get a type +-- discrepancy with the `Name` type from the boot compiler's `template-haskell` +-- library. Most of these are only used to define `Lift` instances, so in the +-- vendored case we simply hide them behind CPP. Yet, there is one distinct use +-- of a `Name`. We have a `Name` for the constructors of the `Multiplicity` +-- type, which are also used in the pretty-printing module. We construct these +-- manulally instead. This allows us to completely avoid using bracket syntax +-- for compiling the vendored `template-haskell` package. +-- +-- To summarise, our current approach allows us to use the external interpreter +-- to run splices and allows bracket syntax to be desugared correctly. In order +-- to implement this we vendor the `template-haskell` library into `ghc-boot` +-- and take special care to not use bracket syntax in those modules as that +-- would incorrectly produce code that uses identifiers from the boot compiler's +-- `template-haskell` library. +-- +-- See #23536. ===================================== compiler/ghc.cabal.in ===================================== @@ -115,7 +115,6 @@ Library containers >= 0.6.2.1 && < 0.8, array >= 0.1 && < 0.6, filepath >= 1 && < 1.6, - template-haskell == 2.22.*, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -35,7 +35,10 @@ extra_dependencies = where th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") - dep (p1, m1) (p2, m2) s = do + dep (p1, m1) (p2, m2) s = + -- We use the boot compiler's `template-haskell` library when building stage0, + -- so we don't need to register dependencies. + if isStage0 s then pure [] else do let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set") ways <- interpretInContext context getLibraryWays mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways) ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,7 +158,6 @@ toolTargets = [ binary -- , ghc -- # depends on ghc library -- , runGhc -- # depends on ghc library , ghcBoot - , ghcBootTh , ghcPlatform , ghcToolchain , ghcToolchainBin @@ -172,7 +171,6 @@ toolTargets = [ binary , mtl , parsec , time - , templateHaskell , text , transformers , semaphoreCompat ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -93,7 +93,6 @@ stage0Packages = do , ghc , runGhc , ghcBoot - , ghcBootTh , ghcPlatform , ghcHeap , ghcToolchain @@ -108,7 +107,6 @@ stage0Packages = do , parsec , semaphoreCompat , time - , templateHaskell , text , transformers , unlit @@ -143,6 +141,7 @@ stage1Packages = do , deepseq , exceptions , ghc + , ghcBootTh , ghcBignum , ghcCompact , ghcExperimental @@ -156,6 +155,7 @@ stage1Packages = do , pretty , rts , semaphoreCompat + , templateHaskell , stm , unlit , xhtml ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -121,6 +121,10 @@ packageArgs = do , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ? input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ] + -------------------------------- ghcBoot ------------------------------ + , package ghcBoot ? + builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap-th") + --------------------------------- ghci --------------------------------- , package ghci ? mconcat [ ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -35,6 +35,15 @@ source-repository head location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/ghc-boot +Flag bootstrap-th + Description: + Enabled when building the stage1 compiler in order to vendor the in-tree + `template-haskell` library, while allowing dependencies to depend on the + boot `template-haskell` library. + See Note [Bootstrapping Template Haskell] + Default: False + Manual: True + Library default-language: Haskell2010 other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables @@ -56,13 +65,6 @@ Library GHC.UniqueSubdir GHC.Version - -- reexport modules from ghc-boot-th so that packages don't have to import - -- both ghc-boot and ghc-boot-th. It makes the dependency graph easier to - -- understand and to refactor. - reexported-modules: - GHC.LanguageExtensions.Type - , GHC.ForeignSrcLang.Type - , GHC.Lexeme -- reexport platform modules from ghc-platform reexported-modules: @@ -81,7 +83,49 @@ Library filepath >= 1.3 && < 1.6, deepseq >= 1.4 && < 1.6, ghc-platform >= 0.1, - ghc-boot-th == @ProjectVersionMunged@ + if flag(bootstrap-th) + cpp-options: -DBOOTSTRAP_TH + build-depends: + ghc-prim + , pretty + -- we vendor ghc-boot-th and template-haskell while bootstrapping TH. + -- This is to avoid having two copies of ghc-boot-th and template-haskell + -- in the build graph: one from the boot compiler and the in-tree one. + hs-source-dirs: . ../ghc-boot-th ../template-haskell ../template-haskell/vendored-filepath + exposed-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Lib + , Language.Haskell.TH.Ppr + , Language.Haskell.TH.PprLib + , Language.Haskell.TH.Quote + , Language.Haskell.TH.Syntax + , Language.Haskell.TH.LanguageExtensions + , Language.Haskell.TH.CodeDo + , Language.Haskell.TH.Lib.Internal + + other-modules: + Language.Haskell.TH.Lib.Map + , System.FilePath + , System.FilePath.Posix + , System.FilePath.Windows + else + hs-source-dirs: . + build-depends: + ghc-boot-th == @ProjectVersionMunged@ + , template-haskell == 2.22.0.0 + -- reexport modules from ghc-boot-th and template-haskell so that packages + -- don't have to import all of ghc-boot, ghc-boot-th and template-haskell. + -- It makes the dependency graph easier to understand and to refactor + -- and reduces the amount of cabal flags we need to use for bootstrapping TH. + reexported-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Syntax if !os(windows) build-depends: unix >= 2.7 && < 2.9 ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -84,7 +84,6 @@ library filepath >= 1.4 && < 1.6, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, - template-haskell == 2.22.*, transformers >= 0.5 && < 0.7 if !os(windows) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -34,49 +34,54 @@ module Language.Haskell.TH.Syntax -- $infix ) where -import qualified Data.Fixed as Fixed +import Prelude import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import System.FilePath import GHC.IO.Unsafe ( unsafeDupableInterleaveIO ) -import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Fix (MonadFix (..)) -import Control.Applicative (Applicative(..)) import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO) import Control.Exception.Base (FixIOException (..)) import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar) import System.IO ( hPutStrLn, stderr ) -import Data.Char ( isAlpha, isAlphaNum, isUpper, ord ) +import Data.Char ( isAlpha, isAlphaNum, isUpper ) import Data.Int import Data.List.NonEmpty ( NonEmpty(..) ) -import Data.Void ( Void, absurd ) import Data.Word import Data.Ratio -import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) -import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), - TYPE, RuntimeRep(..), Levity(..), 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 ) import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions -import Numeric.Natural import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types +#ifdef BOOTSTRAP_TH +import GHC.Types (TYPE, RuntimeRep(..), Levity(..)) +#else +import Control.Monad (liftM) +import Data.Char (ord) +import qualified Data.Fixed as Fixed +import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) +import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), + TYPE, RuntimeRep(..), Levity(..) ) +import GHC.CString ( unpackCString# ) +import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) +import Data.Void ( Void, absurd ) +import Numeric.Natural import Data.Array.Byte (ByteArray(..)) import GHC.Exts ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray# , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents# , copyByteArray#, newPinnedByteArray#) -import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) import GHC.ST (ST(..), runST) +#endif ----------------------------------------------------- -- @@ -1018,6 +1023,8 @@ class Lift (t :: TYPE r) where liftTyped :: Quote m => t -> Code m t +-- See Note [Bootstrapping Template Haskell] +#ifndef BOOTSTRAP_TH -- If you add any instances here, consider updating test th/TH_Lift instance Lift Integer where liftTyped x = unsafeCodeCoerce (lift x) @@ -1384,10 +1391,11 @@ rightName = 'Right nonemptyName :: Name nonemptyName = '(:|) +#endif oneName, manyName :: Name -oneName = 'One -manyName = 'Many +oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" +manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" ----------------------------------------------------- -- ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Posix ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Windows ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c85b3d8be68c000c93698954a7930096f0a499d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c85b3d8be68c000c93698954a7930096f0a499d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 16:50:03 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Thu, 04 Apr 2024 12:50:03 -0400 Subject: [Git][ghc/ghc][wip/fendor/os-string-modlocation] Migrate `Finder` component to `OsPath` Message-ID: <660eda3b2e927_210eac2624b01956f@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/os-string-modlocation at Glasgow Haskell Compiler / GHC Commits: dcd026a7 by Fendor at 2024-04-04T18:49:47+02:00 Migrate `Finder` component to `OsPath` For each module in a GHCi session, we keep alive one `ModLocation`. A `ModLocation` is fairly inefficiently packed, as `String`s are expensive in memory usage. While benchmarking the agda codebase, we concluded that we keep alive around 11MB of `FilePath`'s, solely retained by `ModLocation`. We provide a more densely packed encoding of `ModLocation`, by moving from `FilePath` to `OsPath`. Further, we migrate the full `Finder` component to `OsPath` to avoid unnecessary transformations. As the `Finder` component is well-encapsuled, this requires only a minimal amount of changes in other modules. Bump to haddock submodule for `ModLocation` changes. - - - - - 18 changed files: - compiler/GHC.hs - + compiler/GHC/Data/OsPath.hs - compiler/GHC/Data/Strict.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Location.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - utils/haddock Changes: ===================================== compiler/GHC.hs ===================================== @@ -76,6 +76,12 @@ module GHC ( ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries, mgLookupModule, ModSummary(..), ms_mod_name, ModLocation(..), + ml_hs_file, + ml_hi_file, + ml_dyn_hi_file, + ml_obj_file, + ml_dyn_obj_file, + ml_hie_file, getModSummary, getModuleGraph, isLoaded, ===================================== compiler/GHC/Data/OsPath.hs ===================================== @@ -0,0 +1,22 @@ +module GHC.Data.OsPath + ( + -- * OsPath initialisation and transformation + OsPath + , OsString + , unsafeDecodeUtf + , unsafeEncodeUtf + , os + -- * Common utility functions + , () + , (<.>) + ) + where + +import GHC.Prelude + +import Data.Either +import System.OsPath +import System.Directory.Internal (os) + +unsafeDecodeUtf :: OsPath -> FilePath +unsafeDecodeUtf = fromRight (error "unsafeEncodeUtf: Internal error") . decodeUtf ===================================== compiler/GHC/Data/Strict.hs ===================================== @@ -9,8 +9,11 @@ module GHC.Data.Strict ( Maybe(Nothing, Just), fromMaybe, + GHC.Data.Strict.maybe, Pair(And), - + expectJust, + fromLazy, + toLazy, -- Not used at the moment: -- -- Either(Left, Right), @@ -18,9 +21,12 @@ module GHC.Data.Strict ( ) where import GHC.Prelude hiding (Maybe(..), Either(..)) +import GHC.Stack.Types + import Control.Applicative import Data.Semigroup import Data.Data +import qualified Data.Maybe as Lazy data Maybe a = Nothing | Just !a deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data) @@ -29,6 +35,10 @@ fromMaybe :: a -> Maybe a -> a fromMaybe d Nothing = d fromMaybe _ (Just x) = x +maybe :: b -> (a -> b) -> Maybe a -> b +maybe d _ Nothing = d +maybe _ f (Just x) = f x + apMaybe :: Maybe (a -> b) -> Maybe a -> Maybe b apMaybe (Just f) (Just x) = Just (f x) apMaybe _ _ = Nothing @@ -37,6 +47,19 @@ altMaybe :: Maybe a -> Maybe a -> Maybe a altMaybe Nothing r = r altMaybe l _ = l +fromLazy :: Lazy.Maybe a -> Maybe a +fromLazy (Lazy.Just a) = Just a +fromLazy Lazy.Nothing = Nothing + +toLazy :: Maybe a -> Lazy.Maybe a +toLazy (Just a) = Lazy.Just a +toLazy Nothing = Lazy.Nothing + +expectJust :: HasCallStack => String -> Maybe a -> a +{-# INLINE expectJust #-} +expectJust _ (Just x) = x +expectJust err Nothing = error ("expectJust " ++ err) + instance Semigroup a => Semigroup (Maybe a) where Nothing <> b = b a <> Nothing = a ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -74,6 +74,7 @@ import GHC.Linker.Types import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Maybe +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Data.StringBuffer import GHC.Data.FastString import qualified GHC.Data.EnumSet as EnumSet @@ -772,7 +773,7 @@ summariseRequirement pn mod_name = do let PackageName pn_fs = pn let location = mkHomeModLocation2 fopts mod_name - (unpackFS pn_fs moduleNameSlashes mod_name) "hsig" + (unsafeEncodeUtf $ unpackFS pn_fs moduleNameSlashes mod_name) (unsafeEncodeUtf "hsig") env <- getBkpEnv src_hash <- liftIO $ getFileHash (bkp_filename env) @@ -855,12 +856,12 @@ hsModuleToModSummary home_keys pn hsc_src modname -- these filenames to figure out where the hi files go. -- A travesty! let location0 = mkHomeModLocation2 fopts modname - (unpackFS unit_fs + (unsafeEncodeUtf $ unpackFS unit_fs moduleNameSlashes modname) (case hsc_src of - HsigFile -> "hsig" - HsBootFile -> "hs-boot" - HsSrcFile -> "hs") + HsigFile -> unsafeEncodeUtf "hsig" + HsBootFile -> unsafeEncodeUtf "hs-boot" + HsSrcFile -> unsafeEncodeUtf "hs") -- DANGEROUS: bootifying can POISON the module finder cache let location = case hsc_src of HsBootFile -> addBootSuffixLocnOut location0 ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Driver.Ppr import GHC.Driver.Backend +import GHC.Data.OsPath import qualified GHC.Data.ShortText as ST import GHC.Data.Stream ( Stream ) import qualified GHC.Data.Stream as Stream @@ -259,7 +260,7 @@ outputForeignStubs Maybe FilePath) -- C file created outputForeignStubs logger tmpfs dflags unit_state mod location stubs = do - let stub_h = mkStubPaths (initFinderOpts dflags) (moduleName mod) location + let stub_h = unsafeDecodeUtf $ mkStubPaths (initFinderOpts dflags) (moduleName mod) location stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" case stubs of ===================================== compiler/GHC/Driver/Config/Finder.hs ===================================== @@ -5,30 +5,31 @@ module GHC.Driver.Config.Finder ( import GHC.Prelude +import qualified GHC.Data.Strict as Strict import GHC.Driver.DynFlags import GHC.Unit.Finder.Types import GHC.Data.FastString - +import GHC.Data.OsPath -- | Create a new 'FinderOpts' from DynFlags. initFinderOpts :: DynFlags -> FinderOpts initFinderOpts flags = FinderOpts - { finder_importPaths = importPaths flags + { finder_importPaths = fmap unsafeEncodeUtf $ importPaths flags , finder_lookupHomeInterfaces = isOneShot (ghcMode flags) , finder_bypassHiFileCheck = MkDepend == (ghcMode flags) , finder_ways = ways flags , finder_enableSuggestions = gopt Opt_HelpfulErrors flags - , finder_workingDirectory = workingDirectory flags + , finder_workingDirectory = fmap unsafeEncodeUtf $ Strict.fromLazy $ workingDirectory flags , finder_thisPackageName = mkFastString <$> thisPackageName flags , finder_hiddenModules = hiddenModules flags , finder_reexportedModules = reexportedModules flags - , finder_hieDir = hieDir flags - , finder_hieSuf = hieSuf flags - , finder_hiDir = hiDir flags - , finder_hiSuf = hiSuf_ flags - , finder_dynHiSuf = dynHiSuf_ flags - , finder_objectDir = objectDir flags - , finder_objectSuf = objectSuf_ flags - , finder_dynObjectSuf = dynObjectSuf_ flags - , finder_stubDir = stubDir flags + , finder_hieDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hieDir flags + , finder_hieSuf = unsafeEncodeUtf $ hieSuf flags + , finder_hiDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hiDir flags + , finder_hiSuf = unsafeEncodeUtf $ hiSuf_ flags + , finder_dynHiSuf = unsafeEncodeUtf $ dynHiSuf_ flags + , finder_objectDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ objectDir flags + , finder_objectSuf = unsafeEncodeUtf $ objectSuf_ flags + , finder_dynObjectSuf = unsafeEncodeUtf $ dynObjectSuf_ flags + , finder_stubDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ stubDir flags } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -264,6 +264,8 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString import GHC.Data.Bag +import GHC.Data.OsPath (unsafeEncodeUtf) +import qualified GHC.Data.Strict as Strict import GHC.Data.StringBuffer import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) @@ -2106,12 +2108,12 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs rawCmms return stub_c_exists where - no_loc = ModLocation{ ml_hs_file = Just original_filename, - ml_hi_file = panic "hscCompileCmmFile: no hi file", - ml_obj_file = panic "hscCompileCmmFile: no obj file", - ml_dyn_obj_file = panic "hscCompileCmmFile: no dyn obj file", - ml_dyn_hi_file = panic "hscCompileCmmFile: no dyn obj file", - ml_hie_file = panic "hscCompileCmmFile: no hie file"} + no_loc = ModLocation{ ml_hs_file_ = Strict.Just $ unsafeEncodeUtf original_filename, + ml_hi_file_ = panic "hscCompileCmmFile: no hi file", + ml_obj_file_ = panic "hscCompileCmmFile: no obj file", + ml_dyn_obj_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_dyn_hi_file_ = panic "hscCompileCmmFile: no dyn obj file", + ml_hie_file_ = panic "hscCompileCmmFile: no hie file"} -------------------- Stuff for new code gen --------------------- @@ -2346,12 +2348,12 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do {- Desugar it -} -- We use a basically null location for iNTERACTIVE - let iNTERACTIVELoc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hsDeclsWithLocation:ml_hi_file", - ml_obj_file = panic "hsDeclsWithLocation:ml_obj_file", - ml_dyn_obj_file = panic "hsDeclsWithLocation:ml_dyn_obj_file", - ml_dyn_hi_file = panic "hsDeclsWithLocation:ml_dyn_hi_file", - ml_hie_file = panic "hsDeclsWithLocation:ml_hie_file" } + let iNTERACTIVELoc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hsDeclsWithLocation:ml_hi_file", + ml_obj_file_ = panic "hsDeclsWithLocation:ml_obj_file", + ml_dyn_obj_file_ = panic "hsDeclsWithLocation:ml_dyn_obj_file", + ml_dyn_hi_file_ = panic "hsDeclsWithLocation:ml_dyn_hi_file", + ml_hie_file_ = panic "hsDeclsWithLocation:ml_hie_file" } ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv {- Simplify -} @@ -2630,12 +2632,12 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- Lint if necessary -} lintInteractiveExpr (text "hscCompileCoreExpr") hsc_env prepd_expr - let this_loc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file", - ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file", - ml_dyn_obj_file = panic "hscCompileCoreExpr': ml_obj_file", - ml_dyn_hi_file = panic "hscCompileCoreExpr': ml_dyn_hi_file", - ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } + let this_loc = ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = panic "hscCompileCoreExpr':ml_hi_file", + ml_obj_file_ = panic "hscCompileCoreExpr':ml_obj_file", + ml_dyn_obj_file_ = panic "hscCompileCoreExpr': ml_obj_file", + ml_dyn_hi_file_ = panic "hscCompileCoreExpr': ml_dyn_hi_file", + ml_hie_file_ = panic "hscCompileCoreExpr':ml_hie_file" } -- Ensure module uniqueness by giving it a name like "GhciNNNN". -- This uniqueness is needed by the JS linker. Without it we break the 1-1 ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -72,10 +72,12 @@ import GHC.Iface.Load ( cannotFindModule ) import GHC.IfaceToCore ( typecheckIface ) import GHC.Iface.Recomp ( RecompileRequired(..), CompileReason(..) ) +import qualified GHC.Data.Strict as Strict import GHC.Data.Bag ( listToBag ) import GHC.Data.Graph.Directed import GHC.Data.FastString import GHC.Data.Maybe ( expectJust ) +import GHC.Data.OsPath ( unsafeEncodeUtf, unsafeDecodeUtf ) import GHC.Data.StringBuffer import qualified GHC.LanguageExtensions as LangExt @@ -336,12 +338,15 @@ warnMissingHomeModules dflags targets mod_graph = -> moduleName (ms_mod mod) == name && tuid == ms_unitid mod TargetFile target_file _ - | Just mod_file <- ml_hs_file (ms_location mod) + | Strict.Just mod_file <- ml_hs_file_ (ms_location mod) -> - augmentByWorkingDirectory dflags target_file == mod_file || + let + target_os_file = unsafeEncodeUtf target_file + in + augmentByWorkingDirectory dflags target_file == unsafeDecodeUtf mod_file || -- Don't warn on B.hs-boot if B.hs is specified (#16551) - addBootSuffix target_file == mod_file || + addBootSuffix target_os_file == mod_file || -- We can get a file target even if a module name was -- originally specified in a command line because it can @@ -1830,7 +1835,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf let dyn_tn = tn -<.> dynsuf addFilesToClean tmpfs dynLife [dyn_tn] - return (tn, dyn_tn) + return (unsafeEncodeUtf tn, unsafeEncodeUtf dyn_tn) -- We don't want to create .o or .hi files unless we have been asked -- to by the user. But we need them, so we patch their locations in -- the ModSummary with temporary files. @@ -1839,8 +1844,8 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- If ``-fwrite-interface` is specified, then the .o and .hi files -- are written into `-odir` and `-hidir` respectively. #16670 if gopt Opt_WriteInterface dflags - then return ((ml_hi_file ms_location, ml_dyn_hi_file ms_location) - , (ml_obj_file ms_location, ml_dyn_obj_file ms_location)) + then return ((ml_hi_file_ ms_location, ml_dyn_hi_file_ ms_location) + , (ml_obj_file_ ms_location, ml_dyn_obj_file_ ms_location)) else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) let new_dflags = case enable_spec of @@ -1849,10 +1854,10 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} let ms' = ms { ms_location = - ms_location { ml_hi_file = hi_file - , ml_obj_file = o_file - , ml_dyn_hi_file = dyn_hi_file - , ml_dyn_obj_file = dyn_o_file } + ms_location { ml_hi_file_ = hi_file + , ml_obj_file_ = o_file + , ml_dyn_hi_file_ = dyn_hi_file + , ml_dyn_obj_file_ = dyn_o_file } , ms_hspp_opts = updOptLevel 0 $ new_dflags } -- Recursive call to catch the other cases @@ -2037,7 +2042,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf let fopts = initFinderOpts (hsc_dflags hsc_env) -- Make a ModLocation for this file - let location = mkHomeModLocation fopts pi_mod_name src_fn + let location = mkHomeModLocation fopts pi_mod_name (unsafeEncodeUtf src_fn) -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Driver.Env import GHC.Driver.Errors.Types import qualified GHC.SysTools as SysTools import GHC.Data.Graph.Directed ( SCC(..) ) +import GHC.Data.OsPath (unsafeDecodeUtf) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SourceError @@ -297,7 +298,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do Found loc _ -- Home package: just depend on the .hi or hi-boot file | isJust (ml_hs_file loc) || include_pkg_deps - -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc))) + -> return (Just (unsafeDecodeUtf $ addBootSuffix_maybe is_boot (ml_hi_file_ loc))) -- Not in this package: we don't need a dependency | otherwise ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -58,6 +58,7 @@ import GHC.Iface.Make import GHC.Driver.Config.Parser import GHC.Parser.Header import GHC.Data.StringBuffer +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Types.SourceError import GHC.Unit.Finder import Data.IORef @@ -759,7 +760,7 @@ mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO Mod mkOneShotModLocation pipe_env dflags src_flavour mod_name = do let PipeEnv{ src_basename=basename, src_suffix=suff } = pipe_env - let location1 = mkHomeModLocation2 fopts mod_name basename suff + let location1 = mkHomeModLocation2 fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff) -- Boot-ify it if necessary let location2 @@ -771,11 +772,11 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do -- This can't be done in mkHomeModuleLocation because -- it only applies to the module being compiles let ohi = outputHi dflags - location3 | Just fn <- ohi = location2{ ml_hi_file = fn } + location3 | Just fn <- ohi = location2{ ml_hi_file_ = unsafeEncodeUtf fn } | otherwise = location2 let dynohi = dynOutputHi dflags - location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file = fn } + location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file_ = unsafeEncodeUtf fn } | otherwise = location3 -- Take -o into account if present @@ -789,10 +790,10 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do location5 | Just ofile <- expl_o_file , let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file , isNoLink (ghcLink dflags) - = location4 { ml_obj_file = ofile - , ml_dyn_obj_file = dyn_ofile } + = location4 { ml_obj_file_ = unsafeEncodeUtf ofile + , ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | Just dyn_ofile <- expl_dyn_o_file - = location4 { ml_dyn_obj_file = dyn_ofile } + = location4 { ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile } | otherwise = location4 return location5 where ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Utils.Panic.Plain import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Data.Maybe +import GHC.Data.OsPath import GHC.Prelude import GHC.Unit import GHC.Unit.Env @@ -55,13 +56,13 @@ cantFindInstalledErr unit_state mhome_unit profile mod_name find_result InstalledNotFound files mb_pkg | Just pkg <- mb_pkg , notHomeUnitId mhome_unit pkg - -> not_found_in_package pkg files + -> not_found_in_package pkg $ fmap unsafeDecodeUtf files | null files -> NotAModule | otherwise - -> CouldntFindInFiles files + -> CouldntFindInFiles $ fmap unsafeDecodeUtf files _ -> panic "cantFindInstalledErr" ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -42,6 +42,9 @@ import GHC.Platform.Ways import GHC.Builtin.Names ( gHC_PRIM ) +import qualified GHC.Data.Strict as Strict +import GHC.Data.OsPath + import GHC.Unit.Env import GHC.Unit.Types import GHC.Unit.Module @@ -49,7 +52,6 @@ import GHC.Unit.Home import GHC.Unit.State import GHC.Unit.Finder.Types -import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.ShortText as ST import GHC.Utils.Misc @@ -61,8 +63,7 @@ import GHC.Types.PkgQual import GHC.Fingerprint import Data.IORef -import System.Directory -import System.FilePath +import System.Directory.OsPath import Control.Monad import Data.Time import qualified Data.Map as M @@ -70,9 +71,10 @@ import GHC.Driver.Env ( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env) ) import GHC.Driver.Config.Finder import qualified Data.Set as Set +import qualified System.OsPath as OsPath -type FileExt = String -- Filename extension -type BaseName = String -- Basename of file +type FileExt = OsString -- Filename extension +type BaseName = OsPath -- Basename of file -- ----------------------------------------------------------------------------- -- The Finder @@ -286,7 +288,7 @@ findLookupResult fc fopts r = case r of -- implicit locations from the instances InstalledFound loc _ -> return (Found loc m) InstalledNoPackage _ -> return (NoPackage (moduleUnit m)) - InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m) + InstalledNotFound fp _ -> return (NotFound{ fr_paths = fmap unsafeDecodeUtf fp, fr_pkg = Just (moduleUnit m) , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_unusables = [] @@ -357,7 +359,7 @@ findHomeModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -382,7 +384,7 @@ findHomePackageModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkModule uid mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -413,22 +415,22 @@ findInstalledHomeModule fc fopts home_unit mod_name = do let maybe_working_dir = finder_workingDirectory fopts home_path = case maybe_working_dir of - Nothing -> finder_importPaths fopts - Just fp -> augmentImports fp (finder_importPaths fopts) + Strict.Nothing -> finder_importPaths fopts + Strict.Just fp -> augmentImports fp (finder_importPaths fopts) hi_dir_path = case finder_hiDir fopts of - Just hiDir -> case maybe_working_dir of - Nothing -> [hiDir] - Just fp -> [fp hiDir] - Nothing -> home_path + Strict.Just hiDir -> case maybe_working_dir of + Strict.Nothing -> [hiDir] + Strict.Just fp -> [fp hiDir] + Strict.Nothing -> home_path hisuf = finder_hiSuf fopts mod = mkModule home_unit mod_name source_exts = - [ ("hs", mkHomeModLocationSearched fopts mod_name "hs") - , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs") - , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig") - , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig") + [ (unsafeEncodeUtf "hs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hs") + , (unsafeEncodeUtf "lhs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhs") + , (unsafeEncodeUtf "hsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hsig") + , (unsafeEncodeUtf "lhsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhsig") ] -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that @@ -453,10 +455,11 @@ findInstalledHomeModule fc fopts home_unit mod_name = do else searchPathExts search_dirs mod exts -- | Prepend the working directory to the search path. -augmentImports :: FilePath -> [FilePath] -> [FilePath] +augmentImports :: OsPath -> [OsPath] -> [OsPath] augmentImports _work_dir [] = [] -augmentImports work_dir (fp:fps) | isAbsolute fp = fp : augmentImports work_dir fps - | otherwise = (work_dir fp) : augmentImports work_dir fps +augmentImports work_dir (fp:fps) + | OsPath.isAbsolute fp = fp : augmentImports work_dir fps + | otherwise = (work_dir fp) : augmentImports work_dir fps -- | Search for a module in external packages only. findPackageModule :: FinderCache -> UnitState -> FinderOpts -> InstalledModule -> IO InstalledFindResult @@ -488,14 +491,14 @@ findPackageModule_ fc fopts mod pkg_conf = do tag = waysBuildTag (finder_ways fopts) -- hi-suffix for packages depends on the build tag. - package_hisuf | null tag = "hi" - | otherwise = tag ++ "_hi" + package_hisuf | null tag = unsafeEncodeUtf $ "hi" + | otherwise = unsafeEncodeUtf $ tag ++ "_hi" - package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" + package_dynhisuf = unsafeEncodeUtf $ waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf package_dynhisuf - import_dirs = map ST.unpack $ unitImportDirs pkg_conf + import_dirs = map (unsafeEncodeUtf . ST.unpack) $ unitImportDirs pkg_conf -- we never look for a .hi-boot file in an external package; -- .hi-boot files only make sense for the home package. in @@ -503,7 +506,7 @@ findPackageModule_ fc fopts mod pkg_conf = do [one] | finder_bypassHiFileCheck fopts -> -- there's only one place that this .hi file can be, so -- don't bother looking for it. - let basename = moduleNameSlashes (moduleName mod) + let basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) loc = mk_hi_loc one basename in return $ InstalledFound loc mod _otherwise -> @@ -512,24 +515,24 @@ findPackageModule_ fc fopts mod pkg_conf = do -- ----------------------------------------------------------------------------- -- General path searching -searchPathExts :: [FilePath] -- paths to search +searchPathExts :: [OsPath] -- paths to search -> InstalledModule -- module name -> [ ( FileExt, -- suffix - FilePath -> BaseName -> ModLocation -- action + OsPath -> BaseName -> ModLocation -- action ) ] -> IO InstalledFindResult searchPathExts paths mod exts = search to_search where - basename = moduleNameSlashes (moduleName mod) + basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) - to_search :: [(FilePath, ModLocation)] + to_search :: [(OsPath, ModLocation)] to_search = [ (file, fn path basename) | path <- paths, (ext,fn) <- exts, - let base | path == "." = basename + let base | path == unsafeEncodeUtf "." = basename | otherwise = path basename file = base <.> ext ] @@ -543,7 +546,7 @@ searchPathExts paths mod exts = search to_search else search rest mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt - -> FilePath -> BaseName -> ModLocation + -> OsPath -> BaseName -> ModLocation mkHomeModLocationSearched fopts mod suff path basename = mkHomeModLocation2 fopts mod (path basename) suff @@ -581,18 +584,18 @@ mkHomeModLocationSearched fopts mod suff path basename = -- ext -- The filename extension of the source file (usually "hs" or "lhs"). -mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation +mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> ModLocation mkHomeModLocation dflags mod src_filename = - let (basename,extension) = splitExtension src_filename + let (basename,extension) = OsPath.splitExtension src_filename in mkHomeModLocation2 dflags mod basename extension mkHomeModLocation2 :: FinderOpts -> ModuleName - -> FilePath -- Of source module, without suffix - -> String -- Suffix + -> OsPath -- Of source module, without suffix + -> FileExt -- Suffix -> ModLocation mkHomeModLocation2 fopts mod src_basename ext = - let mod_basename = moduleNameSlashes mod + let mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod obj_fn = mkObjPath fopts src_basename mod_basename dyn_obj_fn = mkDynObjPath fopts src_basename mod_basename @@ -600,72 +603,72 @@ mkHomeModLocation2 fopts mod src_basename ext = dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename hie_fn = mkHiePath fopts src_basename mod_basename - in (ModLocation{ ml_hs_file = Just (src_basename <.> ext), - ml_hi_file = hi_fn, - ml_dyn_hi_file = dyn_hi_fn, - ml_obj_file = obj_fn, - ml_dyn_obj_file = dyn_obj_fn, - ml_hie_file = hie_fn }) + in (ModLocation{ ml_hs_file_ = Strict.Just (src_basename <.> ext), + ml_hi_file_ = hi_fn, + ml_dyn_hi_file_ = dyn_hi_fn, + ml_obj_file_ = obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, + ml_hie_file_ = hie_fn }) mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName - -> FilePath + -> OsPath -> BaseName -> ModLocation mkHomeModHiOnlyLocation fopts mod path basename = - let loc = mkHomeModLocation2 fopts mod (path basename) "" - in loc { ml_hs_file = Nothing } + let loc = mkHomeModLocation2 fopts mod (path basename) mempty + in loc { ml_hs_file_ = Strict.Nothing } -- This function is used to make a ModLocation for a package module. Hence why -- we explicitly pass in the interface file suffixes. -mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String +mkHiOnlyModLocation :: FinderOpts -> FileExt -> FileExt -> OsPath -> OsPath -> ModLocation mkHiOnlyModLocation fopts hisuf dynhisuf path basename = let full_basename = path basename obj_fn = mkObjPath fopts full_basename basename dyn_obj_fn = mkDynObjPath fopts full_basename basename hie_fn = mkHiePath fopts full_basename basename - in ModLocation{ ml_hs_file = Nothing, - ml_hi_file = full_basename <.> hisuf, + in ModLocation{ ml_hs_file_ = Strict.Nothing, + ml_hi_file_ = full_basename <.> hisuf, -- Remove the .hi-boot suffix from -- hi_file, if it had one. We always -- want the name of the real .hi file -- in the ml_hi_file field. - ml_dyn_obj_file = dyn_obj_fn, + ml_dyn_obj_file_ = dyn_obj_fn, -- MP: TODO - ml_dyn_hi_file = full_basename <.> dynhisuf, - ml_obj_file = obj_fn, - ml_hie_file = hie_fn + ml_dyn_hi_file_ = full_basename <.> dynhisuf, + ml_obj_file_ = obj_fn, + ml_hie_file_ = hie_fn } -- | Constructs the filename of a .o file for a given source file. -- Does /not/ check whether the .o file exists mkObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath -mkObjPath fopts basename mod_basename = obj_basename <.> osuf + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath +mkObjPath fopts basename mod_basename = obj_basename OsPath.<.> osuf where odir = finder_objectDir fopts osuf = finder_objectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir OsPath. mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_o file for a given source file. -- Does /not/ check whether the .dyn_o file exists mkDynObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf where odir = finder_objectDir fopts dynosuf = finder_dynObjectSuf fopts - obj_basename | Just dir <- odir = dir mod_basename + obj_basename | Strict.Just dir <- odir = dir mod_basename | otherwise = basename @@ -673,45 +676,45 @@ mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf -- Does /not/ check whether the .hi file exists mkHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiPath fopts basename mod_basename = hi_basename <.> hisuf where hidir = finder_hiDir fopts hisuf = finder_hiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .dyn_hi file for a given source file. -- Does /not/ check whether the .dyn_hi file exists mkDynHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf where hidir = finder_hiDir fopts dynhisuf = finder_dynHiSuf fopts - hi_basename | Just dir <- hidir = dir mod_basename + hi_basename | Strict.Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .hie file for a given source file. -- Does /not/ check whether the .hie file exists mkHiePath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf where hiedir = finder_hieDir fopts hiesuf = finder_hieSuf fopts - hie_basename | Just dir <- hiedir = dir mod_basename + hie_basename | Strict.Just dir <- hiedir = dir mod_basename | otherwise = basename @@ -726,23 +729,23 @@ mkStubPaths :: FinderOpts -> ModuleName -> ModLocation - -> FilePath + -> OsPath mkStubPaths fopts mod location = let stubdir = finder_stubDir fopts - mod_basename = moduleNameSlashes mod - src_basename = dropExtension $ expectJust "mkStubPaths" - (ml_hs_file location) + mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod + src_basename = OsPath.dropExtension $ Strict.expectJust "mkStubPaths" + (ml_hs_file_ location) stub_basename0 - | Just dir <- stubdir = dir mod_basename + | Strict.Just dir <- stubdir = dir mod_basename | otherwise = src_basename - stub_basename = stub_basename0 ++ "_stub" + stub_basename = stub_basename0 `mappend` unsafeEncodeUtf "_stub" in - stub_basename <.> "h" + stub_basename <.> unsafeEncodeUtf "h" -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -9,6 +9,8 @@ where import GHC.Prelude import GHC.Unit +import GHC.Data.OsPath +import qualified GHC.Data.Strict as Strict import qualified Data.Map as M import GHC.Fingerprint import GHC.Platform.Ways @@ -31,7 +33,7 @@ data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState) data InstalledFindResult = InstalledFound ModLocation InstalledModule | InstalledNoPackage UnitId - | InstalledNotFound [FilePath] (Maybe UnitId) + | InstalledNotFound [OsPath] (Maybe UnitId) -- | The result of searching for an imported module. -- @@ -70,7 +72,7 @@ data FindResult -- -- Should be taken from 'DynFlags' via 'initFinderOpts'. data FinderOpts = FinderOpts - { finder_importPaths :: [FilePath] + { finder_importPaths :: [OsPath] -- ^ Where are we allowed to look for Modules and Source files , finder_lookupHomeInterfaces :: Bool -- ^ When looking up a home module: @@ -88,17 +90,17 @@ data FinderOpts = FinderOpts , finder_enableSuggestions :: Bool -- ^ If we encounter unknown modules, should we suggest modules -- that have a similar name. - , finder_workingDirectory :: Maybe FilePath + , finder_workingDirectory :: Strict.Maybe OsPath , finder_thisPackageName :: Maybe FastString , finder_hiddenModules :: Set.Set ModuleName , finder_reexportedModules :: Set.Set ModuleName - , finder_hieDir :: Maybe FilePath - , finder_hieSuf :: String - , finder_hiDir :: Maybe FilePath - , finder_hiSuf :: String - , finder_dynHiSuf :: String - , finder_objectDir :: Maybe FilePath - , finder_objectSuf :: String - , finder_dynObjectSuf :: String - , finder_stubDir :: Maybe FilePath + , finder_hieDir :: Strict.Maybe OsPath + , finder_hieSuf :: OsString + , finder_hiDir :: Strict.Maybe OsPath + , finder_hiSuf :: OsString + , finder_dynHiSuf :: OsString + , finder_objectDir :: Strict.Maybe OsPath + , finder_objectSuf :: OsString + , finder_dynObjectSuf :: OsString + , finder_stubDir :: Strict.Maybe OsPath } deriving Show ===================================== compiler/GHC/Unit/Module/Location.hs ===================================== @@ -7,10 +7,19 @@ module GHC.Unit.Module.Location , addBootSuffixLocn , addBootSuffixLocnOut , removeBootSuffix + , ml_hs_file + , ml_hi_file + , ml_dyn_hi_file + , ml_obj_file + , ml_dyn_obj_file + , ml_hie_file ) where import GHC.Prelude + +import GHC.Data.OsPath +import qualified GHC.Data.Strict as Strict import GHC.Unit.Types import GHC.Utils.Outputable @@ -39,30 +48,30 @@ import GHC.Utils.Outputable data ModLocation = ModLocation { - ml_hs_file :: Maybe FilePath, + ml_hs_file_ :: Strict.Maybe OsPath, -- ^ The source file, if we have one. Package modules -- probably don't have source files. - ml_hi_file :: FilePath, + ml_hi_file_ :: OsPath, -- ^ Where the .hi file is, whether or not it exists -- yet. Always of form foo.hi, even if there is an -- hi-boot file (we add the -boot suffix later) - ml_dyn_hi_file :: FilePath, + ml_dyn_hi_file_ :: OsPath, -- ^ Where the .dyn_hi file is, whether or not it exists -- yet. - ml_obj_file :: FilePath, + ml_obj_file_ :: OsPath, -- ^ Where the .o file is, whether or not it exists yet. -- (might not exist either because the module hasn't -- been compiled yet, or because it is part of a -- unit with a .a file) - ml_dyn_obj_file :: FilePath, + ml_dyn_obj_file_ :: OsPath, -- ^ Where the .dy file is, whether or not it exists -- yet. - ml_hie_file :: FilePath + ml_hie_file_ :: OsPath -- ^ Where the .hie file is, whether or not it exists -- yet. } deriving Show @@ -71,8 +80,8 @@ instance Outputable ModLocation where ppr = text . show -- | Add the @-boot@ suffix to .hs, .hi and .o files -addBootSuffix :: FilePath -> FilePath -addBootSuffix path = path ++ "-boot" +addBootSuffix :: OsPath -> OsPath +addBootSuffix path = path `mappend` unsafeEncodeUtf "-boot" -- | Remove the @-boot@ suffix to .hs, .hi and .o files removeBootSuffix :: FilePath -> FilePath @@ -82,7 +91,7 @@ removeBootSuffix [] = error "removeBootSuffix: no -boot suffix" -- | Add the @-boot@ suffix if the @Bool@ argument is @True@ -addBootSuffix_maybe :: IsBootInterface -> FilePath -> FilePath +addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath addBootSuffix_maybe is_boot path = case is_boot of IsBoot -> addBootSuffix path NotBoot -> path @@ -95,22 +104,42 @@ addBootSuffixLocn_maybe is_boot locn = case is_boot of -- | Add the @-boot@ suffix to all file paths associated with the module addBootSuffixLocn :: ModLocation -> ModLocation addBootSuffixLocn locn - = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn) - , ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) } + = locn { ml_hs_file_ = fmap addBootSuffix (ml_hs_file_ locn) + , ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } -- | Add the @-boot@ suffix to all output file paths associated with the -- module, not including the input file itself addBootSuffixLocnOut :: ModLocation -> ModLocation addBootSuffixLocnOut locn - = locn { ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) + = locn { ml_hi_file_ = addBootSuffix (ml_hi_file_ locn) + , ml_dyn_hi_file_ = addBootSuffix (ml_dyn_hi_file_ locn) + , ml_obj_file_ = addBootSuffix (ml_obj_file_ locn) + , ml_dyn_obj_file_ = addBootSuffix (ml_dyn_obj_file_ locn) + , ml_hie_file_ = addBootSuffix (ml_hie_file_ locn) } +-- ---------------------------------------------------------------------------- +-- Helpers for backwards compatibility +-- ---------------------------------------------------------------------------- + +ml_hs_file :: ModLocation -> Maybe FilePath +ml_hs_file = fmap unsafeDecodeUtf . Strict.toLazy . ml_hs_file_ + +ml_hi_file :: ModLocation -> FilePath +ml_hi_file = unsafeDecodeUtf . ml_hi_file_ + +ml_dyn_hi_file :: ModLocation -> FilePath +ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ + +ml_obj_file :: ModLocation -> FilePath +ml_obj_file = unsafeDecodeUtf . ml_obj_file_ + +ml_dyn_obj_file :: ModLocation -> FilePath +ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ +ml_hie_file :: ModLocation -> FilePath +ml_hie_file = unsafeDecodeUtf . ml_hie_file_ ===================================== compiler/ghc.cabal.in ===================================== @@ -428,6 +428,7 @@ Library GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList + GHC.Data.OsPath GHC.Data.Pair GHC.Data.SmallArray GHC.Data.Stream ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -69,6 +69,7 @@ GHC.Data.List.Infinite GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList +GHC.Data.OsPath GHC.Data.Pair GHC.Data.Strict GHC.Data.StringBuffer ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -70,6 +70,7 @@ GHC.Data.List.Infinite GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList +GHC.Data.OsPath GHC.Data.Pair GHC.Data.Strict GHC.Data.StringBuffer ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe +Subproject commit 1ef6c187b31f85dfd7133b150b211ec9140cc84a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dcd026a7f2979797ef2fffae41aa352b0034b6f1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dcd026a7f2979797ef2fffae41aa352b0034b6f1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 18:48:00 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 14:48:00 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Replace `SizedSeq` with `FlatBag` for flattened structure Message-ID: <660ef5e07b503_3f7027440c00864c9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5f085d3a by Fendor at 2024-04-04T14:47:33-04:00 Replace `SizedSeq` with `FlatBag` for flattened structure LinkedLists are notoriously memory ineffiecient when all we do is traversing a structure. As 'UnlinkedBCO' has been identified as a data structure that impacts the overall memory usage of GHCi sessions, we avoid linked lists and prefer flattened structure for storing. We introduce a new memory efficient representation of sequential elements that has special support for the cases: * Empty * Singleton * Tuple Elements This improves sharing in the 'Empty' case and avoids the overhead of 'Array' until its constant overhead is justified. - - - - - 82cfe10c by Fendor at 2024-04-04T14:47:33-04:00 Compact FlatBag array representation `Array` contains three additional `Word`'s we do not need in `FlatBag`. Move `FlatBag` to `SmallArray`. Expand the API of SmallArray by `sizeofSmallArray` and add common traversal functions, such as `mapSmallArray` and `foldMapSmallArray`. Additionally, allow users to force the elements of a `SmallArray` via `rnfSmallArray`. - - - - - 8 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - + compiler/GHC/Data/FlatBag.hs - compiler/GHC/Data/SmallArray.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -71,9 +71,9 @@ bcoFreeNames bco where bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs) = unionManyUniqDSets ( - mkUniqDSet [ n | BCOPtrName n <- ssElts ptrs ] : - mkUniqDSet [ n | BCONPtrItbl n <- ssElts nonptrs ] : - map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ] + mkUniqDSet [ n | BCOPtrName n <- elemsFlatBag ptrs ] : + mkUniqDSet [ n | BCONPtrItbl n <- elemsFlatBag nonptrs ] : + map bco_refs [ bco | BCOPtrBCO bco <- elemsFlatBag ptrs ] ) -- ----------------------------------------------------------------------------- @@ -215,7 +215,7 @@ assembleBCO platform (ProtoBCO { protoBCOName = nm let asm_insns = ssElts final_insns insns_arr = Array.listArray (0, fromIntegral n_insns - 1) asm_insns bitmap_arr = mkBitmapArray bsize bitmap - ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr final_lits final_ptrs + ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSizedSeq final_lits) (fromSizedSeq final_ptrs) -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive -- objects, since they might get run too early. Disable this until ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -60,10 +60,10 @@ linkBCO interp le bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - lits <- mapM (fmap fromIntegral . lookupLiteral interp le) (ssElts lits0) - ptrs <- mapM (resolvePtr interp le bco_ix) (ssElts ptrs0) + lits <- mapM (fmap fromIntegral . lookupLiteral interp le) (elemsFlatBag lits0) + ptrs <- mapM (resolvePtr interp le bco_ix) (elemsFlatBag ptrs0) return (ResolvedBCO isLittleEndian arity insns bitmap - (listArray (0, fromIntegral (sizeSS lits0)-1) lits) + (listArray (0, fromIntegral (sizeFlatBag lits0)-1) lits) (addListToSS emptySS ptrs)) lookupLiteral :: Interp -> LinkerEnv -> BCONPtr -> IO Word ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -18,12 +18,13 @@ module GHC.ByteCode.Types , CgBreakInfo(..) , ModBreaks (..), BreakIndex, emptyModBreaks , CCostCentre + , FlatBag, sizeFlatBag, fromSizedSeq, elemsFlatBag ) where import GHC.Prelude import GHC.Data.FastString -import GHC.Data.SizedSeq +import GHC.Data.FlatBag import GHC.Types.Name import GHC.Types.Name.Env import GHC.Utils.Outputable @@ -154,8 +155,8 @@ data UnlinkedBCO unlinkedBCOArity :: {-# UNPACK #-} !Int, unlinkedBCOInstrs :: !(UArray Int Word16), -- insns unlinkedBCOBitmap :: !(UArray Int Word64), -- bitmap - unlinkedBCOLits :: !(SizedSeq BCONPtr), -- non-ptrs - unlinkedBCOPtrs :: !(SizedSeq BCOPtr) -- ptrs + unlinkedBCOLits :: !(FlatBag BCONPtr), -- non-ptrs + unlinkedBCOPtrs :: !(FlatBag BCOPtr) -- ptrs } instance NFData UnlinkedBCO where @@ -210,8 +211,8 @@ seqCgBreakInfo CgBreakInfo{..} = instance Outputable UnlinkedBCO where ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs) = sep [text "BCO", ppr nm, text "with", - ppr (sizeSS lits), text "lits", - ppr (sizeSS ptrs), text "ptrs" ] + ppr (sizeFlatBag lits), text "lits", + ppr (sizeFlatBag ptrs), text "ptrs" ] instance Outputable CgBreakInfo where ppr info = text "CgBreakInfo" <+> ===================================== compiler/GHC/Data/FlatBag.hs ===================================== @@ -0,0 +1,129 @@ +{-# LANGUAGE UnboxedTuples #-} +module GHC.Data.FlatBag + ( FlatBag + , emptyFlatBag + , unitFlatBag + , sizeFlatBag + , elemsFlatBag + , mappendFlatBag + -- * Construction + , fromList + , fromSizedSeq + ) where + +import GHC.Prelude + +import GHC.Data.SizedSeq (SizedSeq, ssElts, sizeSS) + +import Control.DeepSeq + +import GHC.Data.SmallArray + +-- | Store elements in a flattened representation. +-- +-- A 'FlatBag' is a data structure that stores an ordered list of elements +-- in a flat structure, avoiding the overhead of a linked list. +-- Use this data structure, if the code requires the following properties: +-- +-- * Elements are stored in a long-lived object, and benefit from a flattened +-- representation. +-- * The 'FlatBag' will be traversed but not extended or filtered. +-- * The number of elements should be known. +-- * Sharing of the empty case improves memory behaviour. +-- +-- A 'FlagBag' aims to have as little overhead as possible to store its elements. +-- To achieve that, it distinguishes between the empty case, singleton, tuple +-- and general case. +-- Thus, we only pay for the additional three words of an 'Array' if we have at least +-- three elements. +data FlatBag a + = EmptyFlatBag + | UnitFlatBag !a + | TupleFlatBag !a !a + | FlatBag {-# UNPACK #-} !(SmallArray a) + +instance Functor FlatBag where + fmap _ EmptyFlatBag = EmptyFlatBag + fmap f (UnitFlatBag a) = UnitFlatBag $ f a + fmap f (TupleFlatBag a b) = TupleFlatBag (f a) (f b) + fmap f (FlatBag e) = FlatBag $ mapSmallArray f e + +instance Foldable FlatBag where + foldMap _ EmptyFlatBag = mempty + foldMap f (UnitFlatBag a) = f a + foldMap f (TupleFlatBag a b) = f a `mappend` f b + foldMap f (FlatBag arr) = foldMapSmallArray f arr + + length = fromIntegral . sizeFlatBag + +instance Traversable FlatBag where + traverse _ EmptyFlatBag = pure EmptyFlatBag + traverse f (UnitFlatBag a) = UnitFlatBag <$> f a + traverse f (TupleFlatBag a b) = TupleFlatBag <$> f a <*> f b + traverse f fl@(FlatBag arr) = fromList (fromIntegral $ sizeofSmallArray arr) <$> traverse f (elemsFlatBag fl) + +instance NFData a => NFData (FlatBag a) where + rnf EmptyFlatBag = () + rnf (UnitFlatBag a) = rnf a + rnf (TupleFlatBag a b) = rnf a `seq` rnf b + rnf (FlatBag arr) = rnfSmallArray arr + +-- | Create an empty 'FlatBag'. +-- +-- The empty 'FlatBag' is shared over all instances. +emptyFlatBag :: FlatBag a +emptyFlatBag = EmptyFlatBag + +-- | Create a singleton 'FlatBag'. +unitFlatBag :: a -> FlatBag a +unitFlatBag = UnitFlatBag + +-- | Calculate the size of +sizeFlatBag :: FlatBag a -> Word +sizeFlatBag EmptyFlatBag = 0 +sizeFlatBag UnitFlatBag{} = 1 +sizeFlatBag TupleFlatBag{} = 2 +sizeFlatBag (FlatBag arr) = fromIntegral $ sizeofSmallArray arr + +-- | Get all elements that are stored in the 'FlatBag'. +elemsFlatBag :: FlatBag a -> [a] +elemsFlatBag EmptyFlatBag = [] +elemsFlatBag (UnitFlatBag a) = [a] +elemsFlatBag (TupleFlatBag a b) = [a, b] +elemsFlatBag (FlatBag arr) = + [indexSmallArray arr i | i <- [0 .. sizeofSmallArray arr - 1]] + +-- | Combine two 'FlatBag's. +-- +-- The new 'FlatBag' contains all elements from both 'FlatBag's. +-- +-- If one of the 'FlatBag's is empty, the old 'FlatBag' is reused. +mappendFlatBag :: FlatBag a -> FlatBag a -> FlatBag a +mappendFlatBag EmptyFlatBag b = b +mappendFlatBag a EmptyFlatBag = a +mappendFlatBag (UnitFlatBag a) (UnitFlatBag b) = TupleFlatBag a b +mappendFlatBag a b = + fromList (sizeFlatBag a + sizeFlatBag b) + (elemsFlatBag a ++ elemsFlatBag b) + +-- | Store the list in a flattened memory representation, avoiding the memory overhead +-- of a linked list. +-- +-- The size 'n' needs to be smaller or equal to the length of the list. +-- If it is smaller than the length of the list, overflowing elements are +-- discarded. It is undefined behaviour to set 'n' to be bigger than the +-- length of the list. +fromList :: Word -> [a] -> FlatBag a +fromList n elts = + case elts of + [] -> EmptyFlatBag + [a] -> UnitFlatBag a + [a, b] -> TupleFlatBag a b + xs -> + FlatBag (listToArray (fromIntegral n) fst snd (zip [0..] xs)) + +-- | Convert a 'SizedSeq' into its flattened representation. +-- A 'FlatBag a' is more memory efficient than '[a]', if no further modification +-- is necessary. +fromSizedSeq :: SizedSeq a -> FlatBag a +fromSizedSeq s = fromList (sizeSS s) (ssElts s) ===================================== compiler/GHC/Data/SmallArray.hs ===================================== @@ -11,13 +11,18 @@ module GHC.Data.SmallArray , freezeSmallArray , unsafeFreezeSmallArray , indexSmallArray + , sizeofSmallArray , listToArray + , mapSmallArray + , foldMapSmallArray + , rnfSmallArray ) where import GHC.Exts import GHC.Prelude import GHC.ST +import Control.DeepSeq data SmallArray a = SmallArray (SmallArray# a) @@ -64,6 +69,14 @@ unsafeFreezeSmallArray (SmallMutableArray ma) s = case unsafeFreezeSmallArray# ma s of (# s', a #) -> (# s', SmallArray a #) +-- | Get the size of a 'SmallArray' +sizeofSmallArray + :: SmallArray a + -> Int +{-# INLINE sizeofSmallArray #-} +sizeofSmallArray (SmallArray sa#) = + case sizeofSmallArray# sa# of + s -> I# s -- | Index a small-array (no bounds checking!) indexSmallArray @@ -71,9 +84,51 @@ indexSmallArray -> Int -- ^ index -> a {-# INLINE indexSmallArray #-} -indexSmallArray (SmallArray sa#) (I# i) = case indexSmallArray# sa# i of - (# v #) -> v +indexSmallArray (SmallArray sa#) (I# i) = + case indexSmallArray# sa# i of + (# v #) -> v +-- | Map a function over the elements of a 'SmallArray' +-- +mapSmallArray :: (a -> b) -> SmallArray a -> SmallArray b +{-# INLINE mapSmallArray #-} +mapSmallArray f sa = runST $ ST $ \s -> + let + n = sizeofSmallArray sa + go !i saMut# state# + | i < n = + let + a = indexSmallArray sa i + newState# = writeSmallArray saMut# i (f a) state# + in + go (i + 1) saMut# newState# + | otherwise = state# + in + case newSmallArray n (error "SmallArray: internal error, uninitialised elements") s of + (# s', mutArr #) -> + case go 0 mutArr s' of + s'' -> unsafeFreezeSmallArray mutArr s'' + +-- | Fold the values of a 'SmallArray' into a 'Monoid m' of choice +foldMapSmallArray :: Monoid m => (a -> m) -> SmallArray a -> m +{-# INLINE foldMapSmallArray #-} +foldMapSmallArray f sa = go 0 + where + n = sizeofSmallArray sa + go i + | i < n = f (indexSmallArray sa i) `mappend` go (i + 1) + | otherwise = mempty + +-- | Force the elements of the given 'SmallArray' +-- +rnfSmallArray :: NFData a => SmallArray a -> () +{-# INLINE rnfSmallArray #-} +rnfSmallArray sa = go 0 + where + n = sizeofSmallArray sa + go !i + | i < n = rnf (indexSmallArray sa i) `seq` go (i + 1) + | otherwise = () -- | Convert a list into an array. listToArray :: Int -> (e -> Int) -> (e -> a) -> [e] -> SmallArray a ===================================== compiler/ghc.cabal.in ===================================== @@ -414,6 +414,7 @@ Library GHC.Data.FastString GHC.Data.FastString.Env GHC.Data.FiniteMap + GHC.Data.FlatBag GHC.Data.Graph.Base GHC.Data.Graph.Color GHC.Data.Graph.Collapse ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -63,6 +63,7 @@ GHC.Data.FastMutInt GHC.Data.FastString GHC.Data.FastString.Env GHC.Data.FiniteMap +GHC.Data.FlatBag GHC.Data.Graph.Directed GHC.Data.Graph.UnVar GHC.Data.List.Infinite @@ -70,6 +71,7 @@ GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList GHC.Data.Pair +GHC.Data.SmallArray GHC.Data.Strict GHC.Data.StringBuffer GHC.Data.TrieMap ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -64,6 +64,7 @@ GHC.Data.FastMutInt GHC.Data.FastString GHC.Data.FastString.Env GHC.Data.FiniteMap +GHC.Data.FlatBag GHC.Data.Graph.Directed GHC.Data.Graph.UnVar GHC.Data.List.Infinite @@ -71,6 +72,7 @@ GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList GHC.Data.Pair +GHC.Data.SmallArray GHC.Data.Strict GHC.Data.StringBuffer GHC.Data.TrieMap View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c4a96862081f03e2946a2ed7e80c108f06205a1...82cfe10c8c3ec68e1b054e2d6b88e1a8830c60bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c4a96862081f03e2946a2ed7e80c108f06205a1...82cfe10c8c3ec68e1b054e2d6b88e1a8830c60bf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 18:48:34 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 14:48:34 -0400 Subject: [Git][ghc/ghc][master] Change how invisible patterns represented in haskell syntax and TH AST (#24557) Message-ID: <660ef602bdf1e_3f70275a8e30897f5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 36a75b80 by Andrei Borzenkov at 2024-04-04T14:48:10-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Functor.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 - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Zonk/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36a75b80ebe592f582f3f349e8c73b8293d49ed1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36a75b80ebe592f582f3f349e8c73b8293d49ed1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 18:49:19 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 14:49:19 -0400 Subject: [Git][ghc/ghc][master] Fix off by one error in seekBinNoExpand and seekBin Message-ID: <660ef62f2b31_3f70277b3d3893635@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 28009fbc by Matthew Pickering at 2024-04-04T14:48:46-04:00 Fix off by one error in seekBinNoExpand and seekBin - - - - - 1 changed file: - compiler/GHC/Utils/Binary.hs Changes: ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -243,15 +243,18 @@ tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) seekBin :: BinHandle -> Bin a -> IO () seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r - if (p >= sz) + if (p > sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p --- | SeekBin but without calling expandBin +-- | 'seekBinNoExpand' moves the index pointer to the location pointed to +-- by 'Bin a'. +-- This operation may 'panic', if the pointer location is out of bounds of the +-- buffer of 'BinHandle'. seekBinNoExpand :: BinHandle -> Bin a -> IO () seekBinNoExpand (BinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r - if (p >= sz) + if (p > sz) then panic "seekBinNoExpand: seek out of range" else writeFastMutInt ix_r p View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28009fbc26e4aca7a3b05cedb60c5c9baa31223d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28009fbc26e4aca7a3b05cedb60c5c9baa31223d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 19:19:45 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 15:19:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Replace `SizedSeq` with `FlatBag` for flattened structure Message-ID: <660efd5189c5e_3f7027bfdd301003a3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5f085d3a by Fendor at 2024-04-04T14:47:33-04:00 Replace `SizedSeq` with `FlatBag` for flattened structure LinkedLists are notoriously memory ineffiecient when all we do is traversing a structure. As 'UnlinkedBCO' has been identified as a data structure that impacts the overall memory usage of GHCi sessions, we avoid linked lists and prefer flattened structure for storing. We introduce a new memory efficient representation of sequential elements that has special support for the cases: * Empty * Singleton * Tuple Elements This improves sharing in the 'Empty' case and avoids the overhead of 'Array' until its constant overhead is justified. - - - - - 82cfe10c by Fendor at 2024-04-04T14:47:33-04:00 Compact FlatBag array representation `Array` contains three additional `Word`'s we do not need in `FlatBag`. Move `FlatBag` to `SmallArray`. Expand the API of SmallArray by `sizeofSmallArray` and add common traversal functions, such as `mapSmallArray` and `foldMapSmallArray`. Additionally, allow users to force the elements of a `SmallArray` via `rnfSmallArray`. - - - - - 36a75b80 by Andrei Borzenkov at 2024-04-04T14:48:10-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 28009fbc by Matthew Pickering at 2024-04-04T14:48:46-04:00 Fix off by one error in seekBinNoExpand and seekBin - - - - - 367b9b71 by Ben Gamari at 2024-04-04T15:19:35-04:00 compiler: Allow more types in GHCForeignImportPrim For many, many years `GHCForeignImportPrim` has suffered from the rather restrictive limitation of not allowing any non-trivial types in arguments or results. This limitation was justified by the code generator allegely barfing in the presence of such types. However, this restriction appears to originate well before the NCG rewrite and the new NCG does not appear to have any trouble with such types (see the added `T24598` test). Lift this restriction. Fixes #24598. - - - - - 94543adb by Alan Zimmerman at 2024-04-04T15:19:36-04:00 EPA: Use EpaLocation not SrcSpan in ForeignDecls This allows us to update them for makeDeltaAst in ghc-exactprint - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - + compiler/GHC/Data/FlatBag.hs - compiler/GHC/Data/SmallArray.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Functor.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc6495586eeac7f975db9219a861119561c235ad...94543adb99830343aa651973697a36342450cee5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc6495586eeac7f975db9219a861119561c235ad...94543adb99830343aa651973697a36342450cee5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 20:36:16 2024 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Thu, 04 Apr 2024 16:36:16 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/epa-rec-dotdot Message-ID: <660f0f4079b57_3f702715071241108bb@gitlab.mail> Alan Zimmerman pushed new branch wip/az/epa-rec-dotdot at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-rec-dotdot You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Apr 4 22:20:25 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 18:20:25 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: compiler: Allow more types in GHCForeignImportPrim Message-ID: <660f27a75edc2_3f702721b0ce011934e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f4a1d762 by Ben Gamari at 2024-04-04T18:20:01-04:00 compiler: Allow more types in GHCForeignImportPrim For many, many years `GHCForeignImportPrim` has suffered from the rather restrictive limitation of not allowing any non-trivial types in arguments or results. This limitation was justified by the code generator allegely barfing in the presence of such types. However, this restriction appears to originate well before the NCG rewrite and the new NCG does not appear to have any trouble with such types (see the added `T24598` test). Lift this restriction. Fixes #24598. - - - - - c52eb51a by Alan Zimmerman at 2024-04-04T18:20:02-04:00 EPA: Use EpaLocation not SrcSpan in ForeignDecls This allows us to update them for makeDeltaAst in ghc-exactprint - - - - - 19 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/ThToHs.hs - testsuite/tests/ffi/should_fail/ccfail001.stderr - + testsuite/tests/ffi/should_run/T24598.hs - + testsuite/tests/ffi/should_run/T24598.stdout - + testsuite/tests/ffi/should_run/T24598_cmm.cmm - + testsuite/tests/ffi/should_run/T24598b.hs - + testsuite/tests/ffi/should_run/T24598b.stdout - + testsuite/tests/ffi/should_run/T24598b_cmm.cmm - + testsuite/tests/ffi/should_run/T24598c.hs - + testsuite/tests/ffi/should_run/T24598c.stdout - + testsuite/tests/ffi/should_run/T24598c_cmm.cmm - testsuite/tests/ffi/should_run/all.T - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1131,10 +1131,10 @@ type instance XForeignExport GhcTc = Coercion type instance XXForeignDecl (GhcPass _) = DataConCantHappen -type instance XCImport (GhcPass _) = Located SourceText -- original source text for the C entity +type instance XCImport (GhcPass _) = LocatedE SourceText -- original source text for the C entity type instance XXForeignImport (GhcPass _) = DataConCantHappen -type instance XCExport (GhcPass _) = Located SourceText -- original source text for the C entity +type instance XCExport (GhcPass _) = LocatedE SourceText -- original source text for the C entity type instance XXForeignExport (GhcPass _) = DataConCantHappen -- pretty printing of foreign declarations @@ -1399,6 +1399,6 @@ type instance Anno (WarnDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (AnnDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (RoleAnnotDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (Maybe Role) = EpAnnCO -type instance Anno CCallConv = SrcSpan -type instance Anno Safety = SrcSpan -type instance Anno CExportSpec = SrcSpan +type instance Anno CCallConv = EpaLocation +type instance Anno Safety = EpaLocation +type instance Anno CExportSpec = EpaLocation ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -2095,15 +2095,15 @@ instance ToHie (LocatedA (ForeignDecl GhcRn)) where instance ToHie (ForeignImport GhcRn) where toHie (CImport (L c _) (L a _) (L b _) _ _) = concatM $ - [ locOnly a - , locOnly b - , locOnly c + [ locOnlyE a + , locOnlyE b + , locOnlyE c ] instance ToHie (ForeignExport GhcRn) where toHie (CExport (L b _) (L a _)) = concatM $ - [ locOnly a - , locOnly b + [ locOnlyE a + , locOnlyE b ] instance ToHie (LocatedA (WarnDecls GhcRn)) where ===================================== compiler/GHC/Iface/Ext/Utils.hs ===================================== @@ -533,6 +533,10 @@ locOnly (RealSrcSpan span _) = do pure [Node e span []] locOnly _ = pure [] +locOnlyE :: Monad m => EpaLocation -> ReaderT NodeOrigin m [HieAST a] +locOnlyE (EpaSpan s) = locOnly s +locOnlyE _ = pure [] + mkScope :: (HasLoc a) => a -> Scope mkScope a = case getHasLoc a of (RealSrcSpan sp _) -> LocalScope sp ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -39,6 +39,7 @@ module GHC.Parser.Annotation ( -- ** Annotations in 'GenLocated' LocatedA, LocatedL, LocatedC, LocatedN, LocatedAn, LocatedP, SrcSpanAnnA, SrcSpanAnnL, SrcSpanAnnP, SrcSpanAnnC, SrcSpanAnnN, + LocatedE, -- ** Annotation data types used in 'GenLocated' @@ -644,6 +645,8 @@ type SrcSpanAnnL = EpAnn AnnList type SrcSpanAnnP = EpAnn AnnPragma type SrcSpanAnnC = EpAnn AnnContext +type LocatedE = GenLocated EpaLocation + -- | General representation of a 'GenLocated' type carrying a -- parameterised annotation type. type LocatedAn an = GenLocated (EpAnn an) @@ -1049,9 +1052,12 @@ reLoc (L la a) = L (noAnnSrcSpan $ locA (L la a) ) a class HasAnnotation e where noAnnSrcSpan :: SrcSpan -> e -instance HasAnnotation (SrcSpan) where +instance HasAnnotation SrcSpan where noAnnSrcSpan l = l +instance HasAnnotation EpaLocation where + noAnnSrcSpan l = EpaSpan l + instance (NoAnn ann) => HasAnnotation (EpAnn ann) where noAnnSrcSpan l = EpAnn (spanAsAnchor l) noAnn emptyComments @@ -1452,6 +1458,10 @@ instance (Outputable a, OutputableBndr e) pprInfixOcc = pprInfixOcc . unLoc pprPrefixOcc = pprPrefixOcc . unLoc +instance (Outputable e) + => Outputable (GenLocated EpaLocation e) where + ppr = pprLocated + instance Outputable ParenType where ppr t = text (show t) ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -2766,7 +2766,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) = -- name (cf section 8.5.1 in Haskell 2010 report). mkCImport = do let e = unpackFS entity - case parseCImport cconv safety (mkExtName (unLoc v)) e (L loc esrc) of + case parseCImport (reLoc cconv) (reLoc safety) (mkExtName (unLoc v)) e (L loc esrc) of Nothing -> addFatalError $ mkPlainErrorMsgEnvelope loc $ PsErrMalformedEntityString Just importSpec -> return importSpec @@ -2782,7 +2782,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) = then mkExtName (unLoc v) else entity funcTarget = CFunction (StaticTarget esrc entity' Nothing True) - importSpec = CImport (L loc esrc) cconv safety Nothing funcTarget + importSpec = CImport (L (l2l loc) esrc) (reLoc cconv) (reLoc safety) Nothing funcTarget returnSpec spec = return $ \ann -> ForD noExtField $ ForeignImport { fd_i_ext = ann @@ -2796,7 +2796,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) = -- the string "foo" is ambiguous: either a header or a C identifier. The -- C identifier case comes first in the alternatives below, so we pick -- that one. -parseCImport :: Located CCallConv -> Located Safety -> FastString -> String +parseCImport :: LocatedE CCallConv -> LocatedE Safety -> FastString -> String -> Located SourceText -> Maybe (ForeignImport (GhcPass p)) parseCImport cconv safety nm str sourceText = @@ -2826,7 +2826,7 @@ parseCImport cconv safety nm str sourceText = | id_char c -> pfail _ -> return () - mk h n = CImport sourceText cconv safety h n + mk h n = CImport (reLoc sourceText) (reLoc cconv) (reLoc safety) h n hdr_char c = not (isSpace c) -- header files are filenames, which can contain @@ -2861,7 +2861,7 @@ mkExport :: Located CCallConv mkExport (L lc cconv) (L le (StringLiteral esrc entity _), v, ty) = return $ \ann -> ForD noExtField $ ForeignExport { fd_e_ext = ann, fd_name = v, fd_sig_ty = ty - , fd_fe = CExport (L le esrc) (L lc (CExportStatic esrc entity' cconv)) } + , fd_fe = CExport (L (l2l le) esrc) (L (l2l lc) (CExportStatic esrc entity' cconv)) } where entity' | nullFS entity = mkExtName (unLoc v) | otherwise = entity ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -84,7 +84,6 @@ import Control.Monad.Trans.Writer.CPS import Control.Monad.Trans.Class ( lift ) import Data.Maybe (isJust) -import GHC.Types.RepType (tyConPrimRep) import GHC.Builtin.Types (unitTyCon) -- Defines a binding @@ -737,7 +736,6 @@ marshalablePrimTyCon tc = isPrimTyCon tc && not (isLiftedTypeKind (tyConResKind marshalableTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason marshalableTyCon dflags tc | marshalablePrimTyCon tc - , not (null (tyConPrimRep tc)) -- Note [Marshalling void] = validIfUnliftedFFITypes dflags | otherwise = boxedMarshalableTyCon tc @@ -772,7 +770,6 @@ legalFIPrimResultTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledRe -- types and also unboxed tuple and sum result types. legalFIPrimResultTyCon dflags tc | marshalablePrimTyCon tc - , not (null (tyConPrimRep tc)) -- Note [Marshalling void] = validIfUnliftedFFITypes dflags | isUnboxedTupleTyCon tc || isUnboxedSumTyCon tc @@ -786,13 +783,3 @@ validIfUnliftedFFITypes dflags | xopt LangExt.UnliftedFFITypes dflags = IsValid | otherwise = NotValid UnliftedFFITypesNeeded -{- -Note [Marshalling void] -~~~~~~~~~~~~~~~~~~~~~~~ -We don't treat State# (whose PrimRep is VoidRep) as marshalable. -In turn that means you can't write - foreign import foo :: Int -> State# RealWorld - -Reason: the back end falls over with panic "primRepHint:VoidRep"; - and there is no compelling reason to permit it --} ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -799,7 +799,8 @@ cvt_fundep (TH.FunDep xs ys) = do { xs' <- mapM tNameN xs cvtForD :: Foreign -> CvtM (ForeignDecl GhcPs) cvtForD (ImportF callconv safety from nm ty) = - do { l <- getL + do { ls <- getL + ; let l = l2l ls ; if -- the prim and javascript calling conventions do not support headers -- and are inserted verbatim, analogous to mkImport in GHC.Parser.PostProcess | callconv == TH.Prim || callconv == TH.JavaScript @@ -809,7 +810,7 @@ cvtForD (ImportF callconv safety from nm ty) = True))) | Just impspec <- parseCImport (L l (cvt_conv callconv)) (L l safety') (mkFastString (TH.nameBase nm)) - from (L l $ quotedSourceText from) + from (L ls $ quotedSourceText from) -> mk_imp impspec | otherwise -> failWith $ InvalidCCallImpent from } @@ -831,7 +832,8 @@ cvtForD (ImportF callconv safety from nm ty) = cvtForD (ExportF callconv as nm ty) = do { nm' <- vNameN nm ; ty' <- cvtSigType ty - ; l <- getL + ; ls <- getL + ; let l = l2l ls ; let astxt = mkFastString as ; let e = CExport (L l (SourceText astxt)) (L l (CExportStatic (SourceText astxt) astxt ===================================== testsuite/tests/ffi/should_fail/ccfail001.stderr ===================================== @@ -1,6 +1,8 @@ -ccfail001.hs:10:1: error: [GHC-89401] +ccfail001.hs:10:1: error: [GHC-10964] • Unacceptable result type in foreign declaration: ‘State# RealWorld’ cannot be marshalled in a foreign call + UnliftedFFITypes is required to marshal unlifted types • When checking declaration: foreign import ccall safe foo :: Int -> State# RealWorld + Suggested fix: Perhaps you intended to use UnliftedFFITypes ===================================== testsuite/tests/ffi/should_run/T24598.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE MagicHash #-} + +-- | Test that `foreign import prim` imports handle `State#` in results correctly. +module Main where + +import GHC.IO +import GHC.Int +import GHC.Exts + +foreign import prim "hello" + hello# :: State# RealWorld -> (# State# RealWorld, Int# #) + +main :: IO () +main = hello >>= print + +hello :: IO Int +hello = IO $ \s -> case hello# s of (# s', n# #) -> (# s', I# n# #) ===================================== testsuite/tests/ffi/should_run/T24598.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/ffi/should_run/T24598_cmm.cmm ===================================== @@ -0,0 +1,5 @@ +#include "Cmm.h" + +hello() { + return (42); +} ===================================== testsuite/tests/ffi/should_run/T24598b.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE MagicHash #-} + +-- | Test that `foreign import prim` imports handle `State#` in arguments correctly. +module Main where + +import GHC.IO +import GHC.Int +import GHC.Exts + +foreign import prim "hello" + hello# :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #) + +main :: IO () +main = hello 21 >>= print + +hello :: Int -> IO Int +hello (I# n#) = IO $ \s -> + case hello# n# s of (# s', n# #) -> (# s', I# n# #) + ===================================== testsuite/tests/ffi/should_run/T24598b.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/ffi/should_run/T24598b_cmm.cmm ===================================== @@ -0,0 +1,5 @@ +#include "Cmm.h" + +hello(W_ n) { + return (2*n); +} ===================================== testsuite/tests/ffi/should_run/T24598c.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE MagicHash #-} + +-- | Test that `foreign import prim` imports handle `State#` in arguments correctly. +module Main where + +import GHC.IO +import GHC.Exts + +foreign import prim "hello" + hello# :: State# RealWorld -> State# RealWorld + +main :: IO () +main = hello + +hello :: IO () +hello = IO $ \s -> + case hello# s of s' -> (# s', () #) + ===================================== testsuite/tests/ffi/should_run/T24598c.stdout ===================================== @@ -0,0 +1 @@ +hello ===================================== testsuite/tests/ffi/should_run/T24598c_cmm.cmm ===================================== @@ -0,0 +1,15 @@ +#include "Cmm.h" + +#if !defined(UnregisterisedCompiler) +import CLOSURE test_str; +#endif + +section "data" { + test_str: bits8[] "hello"; +} + +hello() { + CInt r; + (r) = ccall puts(test_str "ptr"); + return (); +} ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -268,3 +268,7 @@ test('T24314', # libffi-wasm doesn't support more than 4 args yet when(arch('wasm32'), skip)], compile_and_run, ['T24314_c.c']) + +test('T24598', req_cmm, compile_and_run, ['T24598_cmm.cmm']) +test('T24598b', req_cmm, compile_and_run, ['T24598b_cmm.cmm']) +test('T24598c', req_cmm, compile_and_run, ['T24598c_cmm.cmm']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -738,9 +738,9 @@ printStringAtAAC capture (EpaDelta d cs) s = do -- --------------------------------------------------------------------- -markExternalSourceText :: (Monad m, Monoid w) => SrcSpan -> SourceText -> String -> EP w m () -markExternalSourceText l NoSourceText txt = printStringAtRs (realSrcSpan l) txt >> return () -markExternalSourceText l (SourceText txt) _ = printStringAtRs (realSrcSpan l) (unpackFS txt) >> return () +markExternalSourceTextE :: (Monad m, Monoid w) => EpaLocation -> SourceText -> String -> EP w m EpaLocation +markExternalSourceTextE l NoSourceText txt = printStringAtAA l txt +markExternalSourceTextE l (SourceText txt) _ = printStringAtAA l (unpackFS txt) -- --------------------------------------------------------------------- @@ -1587,6 +1587,15 @@ instance (ExactPrint a) => ExactPrint (Located a) where exact (L l a) = L l <$> markAnnotated a +instance (ExactPrint a) => ExactPrint (LocatedE a) where + getAnnotationEntry (L l _) = Entry l [] emptyComments NoFlushComments CanUpdateAnchorOnly + setAnnotationAnchor (L _ a) anc _ts _cs = L anc a + + exact (L la a) = do + debugM $ "LocatedE a:la loc=" ++ show (ss2range $ locA la) + a' <- markAnnotated a + return (L la a') + instance (ExactPrint a) => ExactPrint (LocatedA a) where getAnnotationEntry = entryFromLocatedA setAnnotationAnchor la anc ts cs = setAnchorAn la anc ts cs @@ -2009,11 +2018,15 @@ instance ExactPrint (ForeignDecl GhcPs) where instance ExactPrint (ForeignImport GhcPs) where getAnnotationEntry = const NoEntryVal setAnnotationAnchor a _ _ _ = a - exact (CImport (L ls src) cconv safety@(L ll _) mh imp) = do + exact (CImport (L ls src) cconv safety@(L l _) mh imp) = do cconv' <- markAnnotated cconv - unless (ll == noSrcSpan) $ markAnnotated safety >> return () - unless (ls == noSrcSpan) $ markExternalSourceText ls src "" >> return () - return (CImport (L ls src) cconv' safety mh imp) + safety' <- if notDodgyE l + then markAnnotated safety + else return safety + ls' <- if notDodgyE ls + then markExternalSourceTextE ls src "" + else return ls + return (CImport (L ls' src) cconv' safety' mh imp) -- --------------------------------------------------------------------- @@ -2023,8 +2036,10 @@ instance ExactPrint (ForeignExport GhcPs) where exact (CExport (L ls src) spec) = do debugM $ "CExport starting" spec' <- markAnnotated spec - unless (ls == noSrcSpan) $ markExternalSourceText ls src "" - return (CExport (L ls src) spec') + ls' <- if notDodgyE ls + then markExternalSourceTextE ls src "" + else return ls + return (CExport (L ls' src) spec') -- --------------------------------------------------------------------- @@ -3240,6 +3255,12 @@ markMaybeDodgyStmts an stmts = return (an, r) else return (an, stmts) +notDodgyE :: EpaLocation -> Bool +notDodgyE anc = + case anc of + EpaSpan s -> isGoodSrcSpan s + EpaDelta{} -> True + -- --------------------------------------------------------------------- instance ExactPrint (HsPragE GhcPs) where getAnnotationEntry HsPragSCC{} = NoEntryVal View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94543adb99830343aa651973697a36342450cee5...c52eb51a530ef4e6e6cf108056e87a74aecdeae1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94543adb99830343aa651973697a36342450cee5...c52eb51a530ef4e6e6cf108056e87a74aecdeae1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 01:30:46 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 21:30:46 -0400 Subject: [Git][ghc/ghc][master] compiler: Allow more types in GHCForeignImportPrim Message-ID: <660f5446d560f_1bd2a1ebe8f8351e5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9b9e031b by Ben Gamari at 2024-04-04T21:30:08-04:00 compiler: Allow more types in GHCForeignImportPrim For many, many years `GHCForeignImportPrim` has suffered from the rather restrictive limitation of not allowing any non-trivial types in arguments or results. This limitation was justified by the code generator allegely barfing in the presence of such types. However, this restriction appears to originate well before the NCG rewrite and the new NCG does not appear to have any trouble with such types (see the added `T24598` test). Lift this restriction. Fixes #24598. - - - - - 12 changed files: - compiler/GHC/Tc/Gen/Foreign.hs - testsuite/tests/ffi/should_fail/ccfail001.stderr - + testsuite/tests/ffi/should_run/T24598.hs - + testsuite/tests/ffi/should_run/T24598.stdout - + testsuite/tests/ffi/should_run/T24598_cmm.cmm - + testsuite/tests/ffi/should_run/T24598b.hs - + testsuite/tests/ffi/should_run/T24598b.stdout - + testsuite/tests/ffi/should_run/T24598b_cmm.cmm - + testsuite/tests/ffi/should_run/T24598c.hs - + testsuite/tests/ffi/should_run/T24598c.stdout - + testsuite/tests/ffi/should_run/T24598c_cmm.cmm - testsuite/tests/ffi/should_run/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -84,7 +84,6 @@ import Control.Monad.Trans.Writer.CPS import Control.Monad.Trans.Class ( lift ) import Data.Maybe (isJust) -import GHC.Types.RepType (tyConPrimRep) import GHC.Builtin.Types (unitTyCon) -- Defines a binding @@ -737,7 +736,6 @@ marshalablePrimTyCon tc = isPrimTyCon tc && not (isLiftedTypeKind (tyConResKind marshalableTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason marshalableTyCon dflags tc | marshalablePrimTyCon tc - , not (null (tyConPrimRep tc)) -- Note [Marshalling void] = validIfUnliftedFFITypes dflags | otherwise = boxedMarshalableTyCon tc @@ -772,7 +770,6 @@ legalFIPrimResultTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledRe -- types and also unboxed tuple and sum result types. legalFIPrimResultTyCon dflags tc | marshalablePrimTyCon tc - , not (null (tyConPrimRep tc)) -- Note [Marshalling void] = validIfUnliftedFFITypes dflags | isUnboxedTupleTyCon tc || isUnboxedSumTyCon tc @@ -786,13 +783,3 @@ validIfUnliftedFFITypes dflags | xopt LangExt.UnliftedFFITypes dflags = IsValid | otherwise = NotValid UnliftedFFITypesNeeded -{- -Note [Marshalling void] -~~~~~~~~~~~~~~~~~~~~~~~ -We don't treat State# (whose PrimRep is VoidRep) as marshalable. -In turn that means you can't write - foreign import foo :: Int -> State# RealWorld - -Reason: the back end falls over with panic "primRepHint:VoidRep"; - and there is no compelling reason to permit it --} ===================================== testsuite/tests/ffi/should_fail/ccfail001.stderr ===================================== @@ -1,6 +1,8 @@ -ccfail001.hs:10:1: error: [GHC-89401] +ccfail001.hs:10:1: error: [GHC-10964] • Unacceptable result type in foreign declaration: ‘State# RealWorld’ cannot be marshalled in a foreign call + UnliftedFFITypes is required to marshal unlifted types • When checking declaration: foreign import ccall safe foo :: Int -> State# RealWorld + Suggested fix: Perhaps you intended to use UnliftedFFITypes ===================================== testsuite/tests/ffi/should_run/T24598.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE MagicHash #-} + +-- | Test that `foreign import prim` imports handle `State#` in results correctly. +module Main where + +import GHC.IO +import GHC.Int +import GHC.Exts + +foreign import prim "hello" + hello# :: State# RealWorld -> (# State# RealWorld, Int# #) + +main :: IO () +main = hello >>= print + +hello :: IO Int +hello = IO $ \s -> case hello# s of (# s', n# #) -> (# s', I# n# #) ===================================== testsuite/tests/ffi/should_run/T24598.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/ffi/should_run/T24598_cmm.cmm ===================================== @@ -0,0 +1,5 @@ +#include "Cmm.h" + +hello() { + return (42); +} ===================================== testsuite/tests/ffi/should_run/T24598b.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE MagicHash #-} + +-- | Test that `foreign import prim` imports handle `State#` in arguments correctly. +module Main where + +import GHC.IO +import GHC.Int +import GHC.Exts + +foreign import prim "hello" + hello# :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #) + +main :: IO () +main = hello 21 >>= print + +hello :: Int -> IO Int +hello (I# n#) = IO $ \s -> + case hello# n# s of (# s', n# #) -> (# s', I# n# #) + ===================================== testsuite/tests/ffi/should_run/T24598b.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/ffi/should_run/T24598b_cmm.cmm ===================================== @@ -0,0 +1,5 @@ +#include "Cmm.h" + +hello(W_ n) { + return (2*n); +} ===================================== testsuite/tests/ffi/should_run/T24598c.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE MagicHash #-} + +-- | Test that `foreign import prim` imports handle `State#` in arguments correctly. +module Main where + +import GHC.IO +import GHC.Exts + +foreign import prim "hello" + hello# :: State# RealWorld -> State# RealWorld + +main :: IO () +main = hello + +hello :: IO () +hello = IO $ \s -> + case hello# s of s' -> (# s', () #) + ===================================== testsuite/tests/ffi/should_run/T24598c.stdout ===================================== @@ -0,0 +1 @@ +hello ===================================== testsuite/tests/ffi/should_run/T24598c_cmm.cmm ===================================== @@ -0,0 +1,15 @@ +#include "Cmm.h" + +#if !defined(UnregisterisedCompiler) +import CLOSURE test_str; +#endif + +section "data" { + test_str: bits8[] "hello"; +} + +hello() { + CInt r; + (r) = ccall puts(test_str "ptr"); + return (); +} ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -268,3 +268,7 @@ test('T24314', # libffi-wasm doesn't support more than 4 args yet when(arch('wasm32'), skip)], compile_and_run, ['T24314_c.c']) + +test('T24598', req_cmm, compile_and_run, ['T24598_cmm.cmm']) +test('T24598b', req_cmm, compile_and_run, ['T24598b_cmm.cmm']) +test('T24598c', req_cmm, compile_and_run, ['T24598c_cmm.cmm']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b9e031b67dbc812c156a4773c0c9d293451fefa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b9e031b67dbc812c156a4773c0c9d293451fefa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 01:31:28 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 Apr 2024 21:31:28 -0400 Subject: [Git][ghc/ghc][master] EPA: Use EpaLocation not SrcSpan in ForeignDecls Message-ID: <660f5470948f6_1bd2a1104a1e038485@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1324b862 by Alan Zimmerman at 2024-04-04T21:30:44-04:00 EPA: Use EpaLocation not SrcSpan in ForeignDecls This allows us to update them for makeDeltaAst in ghc-exactprint - - - - - 7 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/ThToHs.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1131,10 +1131,10 @@ type instance XForeignExport GhcTc = Coercion type instance XXForeignDecl (GhcPass _) = DataConCantHappen -type instance XCImport (GhcPass _) = Located SourceText -- original source text for the C entity +type instance XCImport (GhcPass _) = LocatedE SourceText -- original source text for the C entity type instance XXForeignImport (GhcPass _) = DataConCantHappen -type instance XCExport (GhcPass _) = Located SourceText -- original source text for the C entity +type instance XCExport (GhcPass _) = LocatedE SourceText -- original source text for the C entity type instance XXForeignExport (GhcPass _) = DataConCantHappen -- pretty printing of foreign declarations @@ -1399,6 +1399,6 @@ type instance Anno (WarnDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (AnnDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (RoleAnnotDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (Maybe Role) = EpAnnCO -type instance Anno CCallConv = SrcSpan -type instance Anno Safety = SrcSpan -type instance Anno CExportSpec = SrcSpan +type instance Anno CCallConv = EpaLocation +type instance Anno Safety = EpaLocation +type instance Anno CExportSpec = EpaLocation ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -2095,15 +2095,15 @@ instance ToHie (LocatedA (ForeignDecl GhcRn)) where instance ToHie (ForeignImport GhcRn) where toHie (CImport (L c _) (L a _) (L b _) _ _) = concatM $ - [ locOnly a - , locOnly b - , locOnly c + [ locOnlyE a + , locOnlyE b + , locOnlyE c ] instance ToHie (ForeignExport GhcRn) where toHie (CExport (L b _) (L a _)) = concatM $ - [ locOnly a - , locOnly b + [ locOnlyE a + , locOnlyE b ] instance ToHie (LocatedA (WarnDecls GhcRn)) where ===================================== compiler/GHC/Iface/Ext/Utils.hs ===================================== @@ -533,6 +533,10 @@ locOnly (RealSrcSpan span _) = do pure [Node e span []] locOnly _ = pure [] +locOnlyE :: Monad m => EpaLocation -> ReaderT NodeOrigin m [HieAST a] +locOnlyE (EpaSpan s) = locOnly s +locOnlyE _ = pure [] + mkScope :: (HasLoc a) => a -> Scope mkScope a = case getHasLoc a of (RealSrcSpan sp _) -> LocalScope sp ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -39,6 +39,7 @@ module GHC.Parser.Annotation ( -- ** Annotations in 'GenLocated' LocatedA, LocatedL, LocatedC, LocatedN, LocatedAn, LocatedP, SrcSpanAnnA, SrcSpanAnnL, SrcSpanAnnP, SrcSpanAnnC, SrcSpanAnnN, + LocatedE, -- ** Annotation data types used in 'GenLocated' @@ -644,6 +645,8 @@ type SrcSpanAnnL = EpAnn AnnList type SrcSpanAnnP = EpAnn AnnPragma type SrcSpanAnnC = EpAnn AnnContext +type LocatedE = GenLocated EpaLocation + -- | General representation of a 'GenLocated' type carrying a -- parameterised annotation type. type LocatedAn an = GenLocated (EpAnn an) @@ -1049,9 +1052,12 @@ reLoc (L la a) = L (noAnnSrcSpan $ locA (L la a) ) a class HasAnnotation e where noAnnSrcSpan :: SrcSpan -> e -instance HasAnnotation (SrcSpan) where +instance HasAnnotation SrcSpan where noAnnSrcSpan l = l +instance HasAnnotation EpaLocation where + noAnnSrcSpan l = EpaSpan l + instance (NoAnn ann) => HasAnnotation (EpAnn ann) where noAnnSrcSpan l = EpAnn (spanAsAnchor l) noAnn emptyComments @@ -1452,6 +1458,10 @@ instance (Outputable a, OutputableBndr e) pprInfixOcc = pprInfixOcc . unLoc pprPrefixOcc = pprPrefixOcc . unLoc +instance (Outputable e) + => Outputable (GenLocated EpaLocation e) where + ppr = pprLocated + instance Outputable ParenType where ppr t = text (show t) ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -2766,7 +2766,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) = -- name (cf section 8.5.1 in Haskell 2010 report). mkCImport = do let e = unpackFS entity - case parseCImport cconv safety (mkExtName (unLoc v)) e (L loc esrc) of + case parseCImport (reLoc cconv) (reLoc safety) (mkExtName (unLoc v)) e (L loc esrc) of Nothing -> addFatalError $ mkPlainErrorMsgEnvelope loc $ PsErrMalformedEntityString Just importSpec -> return importSpec @@ -2782,7 +2782,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) = then mkExtName (unLoc v) else entity funcTarget = CFunction (StaticTarget esrc entity' Nothing True) - importSpec = CImport (L loc esrc) cconv safety Nothing funcTarget + importSpec = CImport (L (l2l loc) esrc) (reLoc cconv) (reLoc safety) Nothing funcTarget returnSpec spec = return $ \ann -> ForD noExtField $ ForeignImport { fd_i_ext = ann @@ -2796,7 +2796,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) = -- the string "foo" is ambiguous: either a header or a C identifier. The -- C identifier case comes first in the alternatives below, so we pick -- that one. -parseCImport :: Located CCallConv -> Located Safety -> FastString -> String +parseCImport :: LocatedE CCallConv -> LocatedE Safety -> FastString -> String -> Located SourceText -> Maybe (ForeignImport (GhcPass p)) parseCImport cconv safety nm str sourceText = @@ -2826,7 +2826,7 @@ parseCImport cconv safety nm str sourceText = | id_char c -> pfail _ -> return () - mk h n = CImport sourceText cconv safety h n + mk h n = CImport (reLoc sourceText) (reLoc cconv) (reLoc safety) h n hdr_char c = not (isSpace c) -- header files are filenames, which can contain @@ -2861,7 +2861,7 @@ mkExport :: Located CCallConv mkExport (L lc cconv) (L le (StringLiteral esrc entity _), v, ty) = return $ \ann -> ForD noExtField $ ForeignExport { fd_e_ext = ann, fd_name = v, fd_sig_ty = ty - , fd_fe = CExport (L le esrc) (L lc (CExportStatic esrc entity' cconv)) } + , fd_fe = CExport (L (l2l le) esrc) (L (l2l lc) (CExportStatic esrc entity' cconv)) } where entity' | nullFS entity = mkExtName (unLoc v) | otherwise = entity ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -799,7 +799,8 @@ cvt_fundep (TH.FunDep xs ys) = do { xs' <- mapM tNameN xs cvtForD :: Foreign -> CvtM (ForeignDecl GhcPs) cvtForD (ImportF callconv safety from nm ty) = - do { l <- getL + do { ls <- getL + ; let l = l2l ls ; if -- the prim and javascript calling conventions do not support headers -- and are inserted verbatim, analogous to mkImport in GHC.Parser.PostProcess | callconv == TH.Prim || callconv == TH.JavaScript @@ -809,7 +810,7 @@ cvtForD (ImportF callconv safety from nm ty) = True))) | Just impspec <- parseCImport (L l (cvt_conv callconv)) (L l safety') (mkFastString (TH.nameBase nm)) - from (L l $ quotedSourceText from) + from (L ls $ quotedSourceText from) -> mk_imp impspec | otherwise -> failWith $ InvalidCCallImpent from } @@ -831,7 +832,8 @@ cvtForD (ImportF callconv safety from nm ty) = cvtForD (ExportF callconv as nm ty) = do { nm' <- vNameN nm ; ty' <- cvtSigType ty - ; l <- getL + ; ls <- getL + ; let l = l2l ls ; let astxt = mkFastString as ; let e = CExport (L l (SourceText astxt)) (L l (CExportStatic (SourceText astxt) astxt ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -738,9 +738,9 @@ printStringAtAAC capture (EpaDelta d cs) s = do -- --------------------------------------------------------------------- -markExternalSourceText :: (Monad m, Monoid w) => SrcSpan -> SourceText -> String -> EP w m () -markExternalSourceText l NoSourceText txt = printStringAtRs (realSrcSpan l) txt >> return () -markExternalSourceText l (SourceText txt) _ = printStringAtRs (realSrcSpan l) (unpackFS txt) >> return () +markExternalSourceTextE :: (Monad m, Monoid w) => EpaLocation -> SourceText -> String -> EP w m EpaLocation +markExternalSourceTextE l NoSourceText txt = printStringAtAA l txt +markExternalSourceTextE l (SourceText txt) _ = printStringAtAA l (unpackFS txt) -- --------------------------------------------------------------------- @@ -1587,6 +1587,15 @@ instance (ExactPrint a) => ExactPrint (Located a) where exact (L l a) = L l <$> markAnnotated a +instance (ExactPrint a) => ExactPrint (LocatedE a) where + getAnnotationEntry (L l _) = Entry l [] emptyComments NoFlushComments CanUpdateAnchorOnly + setAnnotationAnchor (L _ a) anc _ts _cs = L anc a + + exact (L la a) = do + debugM $ "LocatedE a:la loc=" ++ show (ss2range $ locA la) + a' <- markAnnotated a + return (L la a') + instance (ExactPrint a) => ExactPrint (LocatedA a) where getAnnotationEntry = entryFromLocatedA setAnnotationAnchor la anc ts cs = setAnchorAn la anc ts cs @@ -2009,11 +2018,15 @@ instance ExactPrint (ForeignDecl GhcPs) where instance ExactPrint (ForeignImport GhcPs) where getAnnotationEntry = const NoEntryVal setAnnotationAnchor a _ _ _ = a - exact (CImport (L ls src) cconv safety@(L ll _) mh imp) = do + exact (CImport (L ls src) cconv safety@(L l _) mh imp) = do cconv' <- markAnnotated cconv - unless (ll == noSrcSpan) $ markAnnotated safety >> return () - unless (ls == noSrcSpan) $ markExternalSourceText ls src "" >> return () - return (CImport (L ls src) cconv' safety mh imp) + safety' <- if notDodgyE l + then markAnnotated safety + else return safety + ls' <- if notDodgyE ls + then markExternalSourceTextE ls src "" + else return ls + return (CImport (L ls' src) cconv' safety' mh imp) -- --------------------------------------------------------------------- @@ -2023,8 +2036,10 @@ instance ExactPrint (ForeignExport GhcPs) where exact (CExport (L ls src) spec) = do debugM $ "CExport starting" spec' <- markAnnotated spec - unless (ls == noSrcSpan) $ markExternalSourceText ls src "" - return (CExport (L ls src) spec') + ls' <- if notDodgyE ls + then markExternalSourceTextE ls src "" + else return ls + return (CExport (L ls' src) spec') -- --------------------------------------------------------------------- @@ -3240,6 +3255,12 @@ markMaybeDodgyStmts an stmts = return (an, r) else return (an, stmts) +notDodgyE :: EpaLocation -> Bool +notDodgyE anc = + case anc of + EpaSpan s -> isGoodSrcSpan s + EpaDelta{} -> True + -- --------------------------------------------------------------------- instance ExactPrint (HsPragE GhcPs) where getAnnotationEntry HsPragSCC{} = NoEntryVal View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1324b8626aeb4dc2d6a04f7605d307ef13d1e0e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1324b8626aeb4dc2d6a04f7605d307ef13d1e0e9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 09:31:59 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Fri, 05 Apr 2024 05:31:59 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] Remove th_hack Message-ID: <660fc50fc35af_1d9be1107393c750ac@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: d835af29 by Teo Camarasu at 2024-04-05T10:31:53+01:00 Remove th_hack This is no longer necessary now that template-haskell is no longer a stage0 package - - - - - 1 changed file: - hadrian/src/Rules/ToolArgs.hs Changes: ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -85,25 +85,13 @@ multiSetup pkg_s = do need (srcs ++ gens) let rexp m = ["-reexported-module", m] let hidir = root "interfaces" pkgPath p - writeFile' (resp_file root p) (intercalate "\n" (th_hack arg_list + writeFile' (resp_file root p) (intercalate "\n" (arg_list ++ modules cd ++ concatMap rexp (reexportModules cd) ++ ["-outputdir", hidir])) return (resp_file root p) - -- The template-haskell package is compiled with -this-unit-id=template-haskell but - -- everything which depends on it depends on `-package-id-template-haskell-2.17.0.0` - -- and so the logic for detetecting which home-units depend on what is defeated. - -- The workaround here is just to rewrite all the `-package-id` arguments to - -- point to `template-haskell` instead which works for the multi-repl case. - -- See #20887 - th_hack :: [String] -> [String] - th_hack ((isPrefixOf "-package-id template-haskell" -> True) : xs) = "-package-id" : "template-haskell" : xs - th_hack (x:xs) = x : th_hack xs - th_hack [] = [] - - toolRuleBody :: FilePath -> Action () toolRuleBody fp = do mm <- dirMap View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d835af29aaf96bbb0682718b9bc24e04bab14081 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d835af29aaf96bbb0682718b9bc24e04bab14081 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 09:48:28 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Fri, 05 Apr 2024 05:48:28 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] 2 commits: Make template-haskell a stage1 package Message-ID: <660fc8ec7d5cf_1d9be113ab1187919f@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: 98729f73 by Teo Camarasu at 2024-04-05T10:48:17+01:00 Make template-haskell a stage1 package Promoting template-haskell from a stage0 to a stage1 package means that we can much more easily refactor template-haskell. In order to accomplish this we now compile stage0 packages using the boot compiler's version of template-haskell. This means that there are now two versions of template-haskell in play: the boot compiler's version, and the in-tree version. When compiling the stage1 compiler, we have to pick a version of template-haskell to use. During bootstrapping we want to use the same version as the final compiler. This forces the in-tree version. We are only able to use the internal interpreter with stage2 onwards. Yet, we could still use the external interpreter. The external interpreter runs splices in another process. Queries and results are seralised. This reduces our compatibility requirements from ABI compatibility with the internal interpreter to mere serialisation compatibility. We may compile GHC against another library to what the external interpreter is compiled against so long as it has exactly the same serialisation of template-haskell types. This opens up the strategy pursued in this patch. When compiling the stage1 compiler we vendor the template-haskell and ghc-boot-th libraries through ghc-boot and use these to define the Template Haskell interface for the external interpreter. Note that at this point we also have the template-haskell and ghc-boot-th packages in our transitive dependency closure from the boot compiler, and some packages like containers have dependencies on these to define Lift instances. Then the external interpreter should be compiled against the regular template-haskell library from the source tree. As this will have the same serialised interface as what we vendor in ghc-boot, we can then run splices. GHC stage2 is compiled as normal as well against the template-haskell library from the source tree. See Note [Bootstrapping Template Haskell] Resolves #23536 - - - - - 36b83a79 by Teo Camarasu at 2024-04-05T10:48:17+01:00 Remove th_hack This is no longer necessary now that template-haskell is no longer a stage0 package - - - - - 11 changed files: - compiler/GHC/Tc/Gen/Splice.hs - compiler/ghc.cabal.in - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs Changes: ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2916,3 +2916,108 @@ tcGetInterp = do case hsc_interp hsc_env of Nothing -> liftIO $ throwIO (InstallationError "Template haskell requires a target code interpreter") Just i -> pure i + +-- Note [Bootstrapping Template Haskell] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Template Haskell requires special attention when compiling GHC. +-- The implementation of the Template Haskell set of features requires tight +-- coupling between the compiler and the `template-haskell` library. +-- This complicates the bootstrapping story as compatibility constraints are +-- placed on the version of `template-haskell` used to compile GHC during a +-- particular stage and the version bundled with it. +-- +-- These constraints can be divided by the features they are used to implement, +-- namely running splices either directly or via the external interpreter, and +-- desugaring bracket syntax. +-- +-- (C1) Executing splices within the compiler: In order to execute a splice +-- within the compiler, we must be able to compile and load code built against +-- the same version of the `template-haskell` library as the compiler. This +-- is an ABI compatibility constraint between the `template-haskell` version of +-- the compiler and the splice. +-- (C2) Executing splices through the external interpreter: In order to execute +-- a splice via the external interpreter, we serialise bytecode, run it with the +-- external interpreter, and communicate back the result through a binary +-- serialised interface. This is a binary serialisation compatibilty constraint +-- between the `template-haskell` version of the compiler and the splice. +-- (C3) Desugaring bracket syntax: Bracket syntax is desugared by referring to a +-- special wired-in package whose package id is `template-haskell`. So for +-- instance an expression `'Just` gets desugared to something of type +-- `template-haskell:Language.Haskell.TH.Syntax.Name`. Importantly, while this +-- identifier is wired-in, the identity of the `template-haskell` package is +-- not. So for instance we can successfully use an expression like +-- `'Just :: Name` while compiling the `template-haskell` package as long as its +-- package id is set to `template-haskell` as `Name` will resolve the the local +-- identifier in the package (and the LHS and RHS will align). On the other +-- hand, if we don't set the special package id, the type of the expression will +-- be `template-haskell:...Name` while the `Name` on the RHS will resolve to the +-- local identifier and we will get a type error. So, bracket syntax assumes the +-- presence of a particular API in the `template-haskell` package, but it allows +-- +-- These constraints are ranked from strongest to weakest. They only apply if we +-- want to support the particular feature associated with them. +-- +-- The tricky case is what do to when building the bootstrapping (stage1) GHC. +-- The stage2 GHC is simpler as it can use the in-tree `template-haskell` +-- package built by the stage1 GHC. +-- +-- We should note that we cannot feasibly use the internal interpreter with a +-- stage1 GHC. This is because the stage1 GHC was compiled with the stage0 GHC, +-- which we assume is a different version. In order to run a splice that too +-- would need to be compiled with the stage0 GHC, and so would all its +-- dependencies. +-- This allows us to disregard (C1) for the stage1 case. +-- +-- In the past, we used to build the stage1 GHC and all its dependencies against +-- the in-tree `template-haskell` library. This meant that we sacrificed (C2) +-- because they are likely not serialisation compatible. We could not sacrifice +-- (C3) because dependencies of GHC (such as `containers` and +-- `template-haskell`) used bracket syntax to define `Lift` instances. This +-- meant that the interface assumed by the boot compiler to implement bracket +-- desugaring could not be modified (not even through CPP as (C1) would +-- constrain us in future stages where we do support the internal interpreter). +-- Yet, bracket syntax did work and gave us splices that desugared to code that +-- referenced the in-tree version of `template-haskell` not the one the boot +-- compiler required. So they could never be run. +-- +-- Our current strategy is to not build `template-haskell` as a stage0 package. +-- All of GHCs dependencies depend on the boot compilers version, and produce +-- runnable splices. How do we deal with the stage1 compiler's dependency on +-- `template-haskell`? There are two options. (D1) depend on the boot +-- compiler's version for stage1 and then depend on the in-tree one in stage2. +-- This violates (C1) and (C2), so we wouldn't be able to run splices at all +-- with the stage1 compiler. Additionally this would introduce quite a bit of +-- CPP into the compiler and mean we would have to stub out much of the +-- template-haskell machinery or have an unrunable compatibilty shim. Or (D2) +-- depend on the in-tree version. +-- +-- (D2) is what we implement, but it is complicated by the fact that it means we +-- practically have two versions of `template-haskell` in the dependency graph +-- of the stage1 compiler. To avoid this, we recall that we only need +-- serliasation compatibility (as per (C2)), so we can avoid a direct dependency +-- on the in-tree version by vendoring it. We choose to vendor it into the +-- `ghc-boot` package as both `lib:ghc` and `ghci` require a dependency on the +-- `template-haskell` interface as they define the two ends of the protocol. +-- This allows us to still run splices through the external interpreter. +-- +-- We should note a futher edge-case with this approach. When compiling our +-- vendored `template-haskell` library, we run afoul of (C3). The library +-- defines several `Name`s using bracket syntax. As this package doesn't claim +-- to be the wired-in package but it defines its own `Name` type, we get a type +-- discrepancy with the `Name` type from the boot compiler's `template-haskell` +-- library. Most of these are only used to define `Lift` instances, so in the +-- vendored case we simply hide them behind CPP. Yet, there is one distinct use +-- of a `Name`. We have a `Name` for the constructors of the `Multiplicity` +-- type, which are also used in the pretty-printing module. We construct these +-- manulally instead. This allows us to completely avoid using bracket syntax +-- for compiling the vendored `template-haskell` package. +-- +-- To summarise, our current approach allows us to use the external interpreter +-- to run splices and allows bracket syntax to be desugared correctly. In order +-- to implement this we vendor the `template-haskell` library into `ghc-boot` +-- and take special care to not use bracket syntax in those modules as that +-- would incorrectly produce code that uses identifiers from the boot compiler's +-- `template-haskell` library. +-- +-- See #23536. ===================================== compiler/ghc.cabal.in ===================================== @@ -115,7 +115,6 @@ Library containers >= 0.6.2.1 && < 0.8, array >= 0.1 && < 0.6, filepath >= 1 && < 1.6, - template-haskell == 2.22.*, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -35,7 +35,10 @@ extra_dependencies = where th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") - dep (p1, m1) (p2, m2) s = do + dep (p1, m1) (p2, m2) s = + -- We use the boot compiler's `template-haskell` library when building stage0, + -- so we don't need to register dependencies. + if isStage0 s then pure [] else do let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set") ways <- interpretInContext context getLibraryWays mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways) ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -85,25 +85,13 @@ multiSetup pkg_s = do need (srcs ++ gens) let rexp m = ["-reexported-module", m] let hidir = root "interfaces" pkgPath p - writeFile' (resp_file root p) (intercalate "\n" (th_hack arg_list + writeFile' (resp_file root p) (intercalate "\n" (arg_list ++ modules cd ++ concatMap rexp (reexportModules cd) ++ ["-outputdir", hidir])) return (resp_file root p) - -- The template-haskell package is compiled with -this-unit-id=template-haskell but - -- everything which depends on it depends on `-package-id-template-haskell-2.17.0.0` - -- and so the logic for detetecting which home-units depend on what is defeated. - -- The workaround here is just to rewrite all the `-package-id` arguments to - -- point to `template-haskell` instead which works for the multi-repl case. - -- See #20887 - th_hack :: [String] -> [String] - th_hack ((isPrefixOf "-package-id template-haskell" -> True) : xs) = "-package-id" : "template-haskell" : xs - th_hack (x:xs) = x : th_hack xs - th_hack [] = [] - - toolRuleBody :: FilePath -> Action () toolRuleBody fp = do mm <- dirMap @@ -158,7 +146,6 @@ toolTargets = [ binary -- , ghc -- # depends on ghc library -- , runGhc -- # depends on ghc library , ghcBoot - , ghcBootTh , ghcPlatform , ghcToolchain , ghcToolchainBin @@ -172,7 +159,6 @@ toolTargets = [ binary , mtl , parsec , time - , templateHaskell , text , transformers , semaphoreCompat ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -93,7 +93,6 @@ stage0Packages = do , ghc , runGhc , ghcBoot - , ghcBootTh , ghcPlatform , ghcHeap , ghcToolchain @@ -108,7 +107,6 @@ stage0Packages = do , parsec , semaphoreCompat , time - , templateHaskell , text , transformers , unlit @@ -143,6 +141,7 @@ stage1Packages = do , deepseq , exceptions , ghc + , ghcBootTh , ghcBignum , ghcCompact , ghcExperimental @@ -156,6 +155,7 @@ stage1Packages = do , pretty , rts , semaphoreCompat + , templateHaskell , stm , unlit , xhtml ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -121,6 +121,10 @@ packageArgs = do , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ? input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ] + -------------------------------- ghcBoot ------------------------------ + , package ghcBoot ? + builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap-th") + --------------------------------- ghci --------------------------------- , package ghci ? mconcat [ ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -35,6 +35,15 @@ source-repository head location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/ghc-boot +Flag bootstrap-th + Description: + Enabled when building the stage1 compiler in order to vendor the in-tree + `template-haskell` library, while allowing dependencies to depend on the + boot `template-haskell` library. + See Note [Bootstrapping Template Haskell] + Default: False + Manual: True + Library default-language: Haskell2010 other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables @@ -56,13 +65,6 @@ Library GHC.UniqueSubdir GHC.Version - -- reexport modules from ghc-boot-th so that packages don't have to import - -- both ghc-boot and ghc-boot-th. It makes the dependency graph easier to - -- understand and to refactor. - reexported-modules: - GHC.LanguageExtensions.Type - , GHC.ForeignSrcLang.Type - , GHC.Lexeme -- reexport platform modules from ghc-platform reexported-modules: @@ -81,7 +83,49 @@ Library filepath >= 1.3 && < 1.6, deepseq >= 1.4 && < 1.6, ghc-platform >= 0.1, - ghc-boot-th == @ProjectVersionMunged@ + if flag(bootstrap-th) + cpp-options: -DBOOTSTRAP_TH + build-depends: + ghc-prim + , pretty + -- we vendor ghc-boot-th and template-haskell while bootstrapping TH. + -- This is to avoid having two copies of ghc-boot-th and template-haskell + -- in the build graph: one from the boot compiler and the in-tree one. + hs-source-dirs: . ../ghc-boot-th ../template-haskell ../template-haskell/vendored-filepath + exposed-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Lib + , Language.Haskell.TH.Ppr + , Language.Haskell.TH.PprLib + , Language.Haskell.TH.Quote + , Language.Haskell.TH.Syntax + , Language.Haskell.TH.LanguageExtensions + , Language.Haskell.TH.CodeDo + , Language.Haskell.TH.Lib.Internal + + other-modules: + Language.Haskell.TH.Lib.Map + , System.FilePath + , System.FilePath.Posix + , System.FilePath.Windows + else + hs-source-dirs: . + build-depends: + ghc-boot-th == @ProjectVersionMunged@ + , template-haskell == 2.22.0.0 + -- reexport modules from ghc-boot-th and template-haskell so that packages + -- don't have to import all of ghc-boot, ghc-boot-th and template-haskell. + -- It makes the dependency graph easier to understand and to refactor + -- and reduces the amount of cabal flags we need to use for bootstrapping TH. + reexported-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + , Language.Haskell.TH + , Language.Haskell.TH.Syntax if !os(windows) build-depends: unix >= 2.7 && < 2.9 ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -84,7 +84,6 @@ library filepath >= 1.4 && < 1.6, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, - template-haskell == 2.22.*, transformers >= 0.5 && < 0.7 if !os(windows) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -34,49 +34,52 @@ module Language.Haskell.TH.Syntax -- $infix ) where -import qualified Data.Fixed as Fixed +import Prelude import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import System.FilePath import GHC.IO.Unsafe ( unsafeDupableInterleaveIO ) -import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Fix (MonadFix (..)) -import Control.Applicative (Applicative(..)) import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO) import Control.Exception.Base (FixIOException (..)) import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar) import System.IO ( hPutStrLn, stderr ) -import Data.Char ( isAlpha, isAlphaNum, isUpper, ord ) +import Data.Char ( isAlpha, isAlphaNum, isUpper ) import Data.Int import Data.List.NonEmpty ( NonEmpty(..) ) -import Data.Void ( Void, absurd ) import Data.Word import Data.Ratio -import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) -import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), - TYPE, RuntimeRep(..), Levity(..), 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 ) import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions -import Numeric.Natural import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types +import GHC.Types (TYPE, RuntimeRep(..), Levity(..)) +#ifndef BOOTSTRAP_TH +import Control.Monad (liftM) +import Data.Char (ord) +import qualified Data.Fixed as Fixed +import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) +import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..)) +import GHC.CString ( unpackCString# ) +import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) +import Data.Void ( Void, absurd ) +import Numeric.Natural import Data.Array.Byte (ByteArray(..)) import GHC.Exts ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray# , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents# , copyByteArray#, newPinnedByteArray#) -import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) import GHC.ST (ST(..), runST) +#endif ----------------------------------------------------- -- @@ -1018,6 +1021,8 @@ class Lift (t :: TYPE r) where liftTyped :: Quote m => t -> Code m t +-- See Note [Bootstrapping Template Haskell] +#ifndef BOOTSTRAP_TH -- If you add any instances here, consider updating test th/TH_Lift instance Lift Integer where liftTyped x = unsafeCodeCoerce (lift x) @@ -1384,10 +1389,11 @@ rightName = 'Right nonemptyName :: Name nonemptyName = '(:|) +#endif oneName, manyName :: Name -oneName = 'One -manyName = 'Many +oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" +manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" ----------------------------------------------------- -- ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Posix ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs ===================================== @@ -102,6 +102,7 @@ module System.FilePath.Windows ) where +import Prelude import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) import Data.List(stripPrefix, isSuffixOf) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d835af29aaf96bbb0682718b9bc24e04bab14081...36b83a79a4ee7654a2a5cdb03d26d13f5d219328 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d835af29aaf96bbb0682718b9bc24e04bab14081...36b83a79a4ee7654a2a5cdb03d26d13f5d219328 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 09:53:59 2024 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 05 Apr 2024 05:53:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/mp-i386-fix Message-ID: <660fca372e49c_1d9be1159af8c811ab@gitlab.mail> Matthew Pickering pushed new branch wip/mp-i386-fix at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mp-i386-fix You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 10:15:25 2024 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 05 Apr 2024 06:15:25 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/remove-test-file Message-ID: <660fcf3d13c25_1d9be118f4bec87624@gitlab.mail> Matthew Pickering pushed new branch wip/remove-test-file at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/remove-test-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 Fri Apr 5 10:25:23 2024 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 05 Apr 2024 06:25:23 -0400 Subject: [Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 13 commits: testsuite: Introduce template-haskell-exports test Message-ID: <660fd193c40c3_1d9be11adc5189098@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC Commits: 0fde229f by Ben Gamari at 2024-04-04T07:04:58-04:00 testsuite: Introduce template-haskell-exports test - - - - - 0c4a9686 by Luite Stegeman at 2024-04-04T07:05:39-04:00 Update correct counter in bumpTickyAllocd - - - - - 5f085d3a by Fendor at 2024-04-04T14:47:33-04:00 Replace `SizedSeq` with `FlatBag` for flattened structure LinkedLists are notoriously memory ineffiecient when all we do is traversing a structure. As 'UnlinkedBCO' has been identified as a data structure that impacts the overall memory usage of GHCi sessions, we avoid linked lists and prefer flattened structure for storing. We introduce a new memory efficient representation of sequential elements that has special support for the cases: * Empty * Singleton * Tuple Elements This improves sharing in the 'Empty' case and avoids the overhead of 'Array' until its constant overhead is justified. - - - - - 82cfe10c by Fendor at 2024-04-04T14:47:33-04:00 Compact FlatBag array representation `Array` contains three additional `Word`'s we do not need in `FlatBag`. Move `FlatBag` to `SmallArray`. Expand the API of SmallArray by `sizeofSmallArray` and add common traversal functions, such as `mapSmallArray` and `foldMapSmallArray`. Additionally, allow users to force the elements of a `SmallArray` via `rnfSmallArray`. - - - - - 36a75b80 by Andrei Borzenkov at 2024-04-04T14:48:10-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 28009fbc by Matthew Pickering at 2024-04-04T14:48:46-04:00 Fix off by one error in seekBinNoExpand and seekBin - - - - - 9b9e031b by Ben Gamari at 2024-04-04T21:30:08-04:00 compiler: Allow more types in GHCForeignImportPrim For many, many years `GHCForeignImportPrim` has suffered from the rather restrictive limitation of not allowing any non-trivial types in arguments or results. This limitation was justified by the code generator allegely barfing in the presence of such types. However, this restriction appears to originate well before the NCG rewrite and the new NCG does not appear to have any trouble with such types (see the added `T24598` test). Lift this restriction. Fixes #24598. - - - - - 1324b862 by Alan Zimmerman at 2024-04-04T21:30:44-04:00 EPA: Use EpaLocation not SrcSpan in ForeignDecls This allows us to update them for makeDeltaAst in ghc-exactprint - - - - - 6e0ffd02 by Rodrigo Mesquita at 2024-04-05T11:24:06+01:00 rts: free error message before returning Fixes a memory leak in rts/linker/PEi386.c - - - - - 648e94ea by Alexis King at 2024-04-05T11:25:03+01:00 linker: Avoid linear search when looking up Haskell symbols via dlsym See the primary Note [Looking up symbols in the relevant objects] for a more in-depth explanation. When dynamically loading a Haskell symbol (typical when running a splice or GHCi expression), before this commit we would search for the symbol in all dynamic libraries that were loaded. However, this could be very inefficient when too many packages are loaded (which can happen if there are many package dependencies) because the time to lookup the would be linear in the number of packages loaded. This commit drastically improves symbol loading performance by introducing a mapping from units to the handles of corresponding loaded dlls. These handles are returned by dlopen when we load a dll, and can then be used to look up in a specific dynamic library. Looking up a given Name is now much more precise because we can get lookup its unit in the mapping and lookup the symbol solely in the handles of the dynamic libraries loaded for that unit. In one measurement, the wait time before the expression was executed went from +-38 seconds down to +-2s. This commit also includes Note [Symbols may not be found in pkgs_loaded], explaining the fallback to the old behaviour in case no dll can be found in the unit mapping for a given Name. Fixes #23415 Co-authored-by: Rodrigo Mesquita (@alt-romes) - - - - - 86f3dd38 by Rodrigo Mesquita at 2024-04-05T11:25:04+01:00 rts: Make addDLL a wrapper around loadNativeObj Rewrite the implementation of `addDLL` as a wrapper around the more principled `loadNativeObj` rts linker function. The latter should be preferred while the former is preserved for backwards compatibility. `loadNativeObj` was previously only available on ELF platforms, so this commit further refactors the rts linker to transform loadNativeObj_ELF into loadNativeObj_POSIX, which is available in ELF and MachO platforms. The refactor made it possible to remove the `dl_mutex` mutex in favour of always using `linker_mutex` (rather than a combination of both). Lastly, we implement `loadNativeObj` for Windows too. - - - - - a409754a by Rodrigo Mesquita at 2024-04-05T11:25:04+01:00 Use symbol cache in internal interpreter too This commit makes the symbol cache that was used by the external interpreter available for the internal interpreter too. This follows from the analysis in #23415 that suggests the internal interpreter could benefit from this cache too, and that there is no good reason not to have the cache for it too. It also makes it a bit more uniform to have the symbol cache range over both the internal and external interpreter. This commit also refactors the cache into a function which is used by both `lookupSymbol` and also by `lookupSymbolInDLL`, extending the caching logic to `lookupSymbolInDLL` too. - - - - - 785937b4 by Ben Gamari at 2024-04-05T11:25:04+01:00 testsuite: Add test for lookupSymbolInNativeObj - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - + compiler/GHC/Data/FlatBag.hs - compiler/GHC/Data/SmallArray.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/MacOS.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1a021a8a4cfe4ee06b840611d035d99191ad5ac8...785937b46351fa021eac5b7bb683b2fa38739302 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1a021a8a4cfe4ee06b840611d035d99191ad5ac8...785937b46351fa021eac5b7bb683b2fa38739302 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 10:51:54 2024 From: gitlab at gitlab.haskell.org (Teo Camarasu (@teo)) Date: Fri, 05 Apr 2024 06:51:54 -0400 Subject: [Git][ghc/ghc][wip/T23536-teo] Apply 5 suggestion(s) to 1 file(s) Message-ID: <660fd7ca2dfa0_1d9be11e268a4940a3@gitlab.mail> Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC Commits: 6fb08605 by Sebastian Graf at 2024-04-05T10:51:50+00:00 Apply 5 suggestion(s) to 1 file(s) - - - - - 1 changed file: - compiler/GHC/Tc/Gen/Splice.hs Changes: ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2919,17 +2919,20 @@ tcGetInterp = do -- Note [Bootstrapping Template Haskell] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- -- Template Haskell requires special attention when compiling GHC. -- The implementation of the Template Haskell set of features requires tight --- coupling between the compiler and the `template-haskell` library. +-- coupling between the compiler and the `template-haskell` library: +-- on one hand, there are many known-key definitions in GHC.Builtin.Names.TH +-- pointing to the in-tree library; +-- on the other hand, the compiler needs to be compiled against parts of the in-tree TH AST +-- to enable serialisation. -- This complicates the bootstrapping story as compatibility constraints are -- placed on the version of `template-haskell` used to compile GHC during a -- particular stage and the version bundled with it. -- -- These constraints can be divided by the features they are used to implement, -- namely running splices either directly or via the external interpreter, and --- desugaring bracket syntax. +-- desugaring quotes. -- -- (C1) Executing splices within the compiler: In order to execute a splice -- within the compiler, we must be able to compile and load code built against @@ -2981,8 +2984,8 @@ tcGetInterp = do -- referenced the in-tree version of `template-haskell` not the one the boot -- compiler required. So they could never be run. -- --- Our current strategy is to not build `template-haskell` as a stage0 package. --- All of GHCs dependencies depend on the boot compilers version, and produce +-- Our current strategy is to avoid building the in-tree `template-haskell` as a stage0 package entirely. +-- All of stage1 GHCs source dependencies depend on the boot compilers version, and produce -- runnable splices. How do we deal with the stage1 compiler's dependency on -- `template-haskell`? There are two options. (D1) depend on the boot -- compiler's version for stage1 and then depend on the in-tree one in stage2. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6fb086057e726b389864a1516bf5e2e1176d47b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6fb086057e726b389864a1516bf5e2e1176d47b5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 11:51:43 2024 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 05 Apr 2024 07:51:43 -0400 Subject: [Git][ghc/ghc][wip/bump-alpine-aarch64] 178 commits: rel_eng: Update hackage docs upload scripts Message-ID: <660fe5cf8a237_180afb7a35b4268e@gitlab.mail> Matthew Pickering pushed to branch wip/bump-alpine-aarch64 at Glasgow Haskell Compiler / GHC Commits: 18ad1077 by Matthew Pickering at 2024-03-05T14:22:31-05:00 rel_eng: Update hackage docs upload scripts This adds the upload of ghc-internal and ghc-experimental to our scripts which upload packages to hackage. - - - - - bf47c9ba by Matthew Pickering at 2024-03-05T14:22:31-05:00 docs: Remove stray module comment from GHC.Profiling.Eras - - - - - 37d9b340 by Matthew Pickering at 2024-03-05T14:22:31-05:00 Fix ghc-internal cabal file The file mentioned some artifacts relating to the base library. I have renamed these to the new ghc-internal variants. - - - - - 23f2a478 by Matthew Pickering at 2024-03-05T14:22:31-05:00 Fix haddock source links and hyperlinked source There were a few issues with the hackage links: 1. We were using the package id rather than the package name for the package links. This is fixed by now allowing the template to mention %pkg% or %pkgid% and substituing both appropiatly. 2. The `--haddock-base-url` flag is renamed to `--haddock-for-hackage` as the new base link works on a local or remote hackage server. 3. The "src" path including too much stuff, so cross-package source links were broken as the template was getting double expanded. Fixes #24086 - - - - - 2fa336a9 by Ben Gamari at 2024-03-05T14:23:07-05:00 filepath: Bump submodule to 1.5.2.0 - - - - - 31217944 by Ben Gamari at 2024-03-05T14:23:07-05:00 os-string: Bump submodule to 2.0.2 - - - - - 4074a3f2 by Matthew Pickering at 2024-03-05T21:44:35-05:00 base: Reflect new era profiling RTS flags in GHC.RTS.Flags * -he profiling mode * -he profiling selector * --automatic-era-increment CLC proposal #254 - https://github.com/haskell/core-libraries-committee/issues/254 - - - - - a8c0e31b by Sylvain Henry at 2024-03-05T21:45:14-05:00 JS: faster implementation for some numeric primitives (#23597) Use faster implementations for the following primitives in the JS backend by not using JavaScript's BigInt: - plusInt64 - minusInt64 - minusWord64 - timesWord64 - timesInt64 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 21e3f325 by Cheng Shao at 2024-03-05T21:45:52-05:00 rts: add -xr option to control two step allocator reserved space size This patch adds a -xr RTS option to control the size of virtual memory address space reserved by the two step allocator on a 64-bit platform, see added documentation for explanation. Closes #24498. - - - - - dedcf102 by Cheng Shao at 2024-03-06T13:39:04-05:00 rts: expose HeapAlloc.h as public header This commit exposes HeapAlloc.h as a public header. The intention is to expose HEAP_ALLOCED/HEAP_ALLOCED_GC, so they can be used in assertions in other public headers, and they may also be useful for user code. - - - - - d19441d7 by Cheng Shao at 2024-03-06T13:39:04-05:00 rts: assert pointer is indeed heap allocated in Bdescr() This commit adds an assertion to Bdescr() to assert the pointer is indeed heap allocated. This is useful to rule out RTS bugs that attempt to access non-existent block descriptor of a static closure, #24492 being one such example. - - - - - 9a656a04 by Ben Gamari at 2024-03-06T13:39:39-05:00 ghc-experimental: Add dummy dependencies to work around #23942 This is a temporary measure to improve CI reliability until a proper solution is developed. Works around #23942. - - - - - 1e84b924 by Simon Peyton Jones at 2024-03-06T13:39:39-05:00 Three compile perf improvements with deep nesting These were changes are all triggered by #24471. 1. Make GHC.Core.Opt.SetLevels.lvlMFE behave better when there are many free variables. See Note [Large free-variable sets]. 2. Make GHC.Core.Opt.Arity.floatIn a bit lazier in its Cost argument. This benefits the common case where the ArityType turns out to be nullary. See Note [Care with nested expressions] 3. Make GHC.CoreToStg.Prep.cpeArg behave for deeply-nested expressions. See Note [Eta expansion of arguments in CorePrep] wrinkle (EA2). Compile times go down by up to 4.5%, and much more in artificial cases. (Geo mean of compiler/perf changes is -0.4%.) Metric Decrease: CoOpt_Read T10421 T12425 - - - - - c4b13113 by Hécate Moonlight at 2024-03-06T13:40:17-05:00 Use "module" instead of "library" when applicable in base haddocks - - - - - 9cd9efb4 by Vladislav Zavialov at 2024-03-07T13:01:54+03:00 Rephrase error message to say "visible arguments" (#24318) * Main change: make the error message generated by mkFunTysMsg more accurate by changing "value arguments" to "visible arguments". * Refactor: define a new type synonym VisArity and use it instead of Arity in a few places. It might be the case that there other places in the compiler that should talk about visible arguments rather than value arguments, but I haven't tried to find them all, focusing only on the error message reported in the ticket. - - - - - d523a6a7 by Ben Gamari at 2024-03-07T19:40:45-05:00 Bump array submodule - - - - - 7e55003c by Ben Gamari at 2024-03-07T19:40:45-05:00 Bump stm submodule - - - - - 32d337ef by Ben Gamari at 2024-03-07T19:40:45-05:00 Introduce exception context Here we introduce the `ExceptionContext` type and `ExceptionAnnotation` class, allowing dynamically-typed user-defined annotations to be attached to exceptions. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/199 GHC Proposal: https://github.com/ghc-proposals/ghc-proposals/pull/330 - - - - - 39f3d922 by Ben Gamari at 2024-03-07T19:40:46-05:00 testsuite/interface-stability: Update documentation - - - - - fdea7ada by Ben Gamari at 2024-03-07T19:40:46-05:00 ghc-internal: comment formatting - - - - - 4fba42ef by Ben Gamari at 2024-03-07T19:40:46-05:00 compiler: Default and warn ExceptionContext constraints - - - - - 3886a205 by Ben Gamari at 2024-03-07T19:40:46-05:00 base: Introduce exception backtraces Here we introduce the `Backtraces` type and associated machinery for attaching these via `ExceptionContext`. These has a few compile-time regressions (`T15703` and `T9872d`) due to the additional dependencies in the exception machinery. As well, there is a surprisingly large regression in the `size_hello_artifact` test. This appears to be due to various `Integer` and `Read` bits now being reachable at link-time. I believe it should be possible to avoid this but I have accepted the change for now to get the feature merged. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/199 GHC Proposal: https://github.com/ghc-proposals/ghc-proposals/pull/330 Metric Increase: T15703 T9872d size_hello_artifact - - - - - 18c5409f by Ben Gamari at 2024-03-07T19:40:46-05:00 users guide: Release notes for exception backtrace work - - - - - f849c5fc by Ben Gamari at 2024-03-07T19:40:46-05:00 compiler: Don't show ExceptionContext of GhcExceptions Most GhcExceptions are user-facing errors and therefore the ExceptionContext has little value. Ideally we would enable it in the DEBUG compiler but I am leaving this for future work. - - - - - dc646e6f by Sylvain Henry at 2024-03-07T19:40:46-05:00 Disable T9930fail for the JS target (cf #19174) - - - - - bfc09760 by Alan Zimmerman at 2024-03-07T19:41:22-05:00 Update showAstData to honour blanking of AnnParen Also tweak rendering of SrcSpan to remove extra blank line. - - - - - 50454a29 by Ben Gamari at 2024-03-08T03:32:42-05:00 ghc-internal: Eliminate GHC.Internal.Data.Kind This was simply reexporting things from `ghc-prim`. Instead reexport these directly from `Data.Kind`. Also add build ordering dependency to work around #23942. - - - - - 38a4b6ab by Ben Gamari at 2024-03-08T03:33:18-05:00 rts: Fix SET_HDR initialization of retainer set This fixes a regression in retainer set profiling introduced by b0293f78cb6acf2540389e22bdda420d0ab874da. Prior to that commit the heap traversal word would be initialized by `SET_HDR` using `LDV_RECORD_CREATE`. However, the commit added a `doingLDVProfiling` check in `LDV_RECORD_CREATE`, meaning that this initialization no longer happened. Given that this initialization was awkwardly indirectly anyways, I have fixed this by explicitly initializating the heap traversal word to `NULL` in `SET_PROF_HDR`. This is equivalent to the previous behavior, but much more direct. Fixes #24513. - - - - - 2859a637 by Ben Gamari at 2024-03-08T18:26:47-05:00 base: Use strerror_r instead of strerror As noted by #24344, `strerror` is not necessarily thread-safe. Thankfully, POSIX.1-2001 has long offered `strerror_r`, which is safe to use. Fixes #24344. CLC discussion: https://github.com/haskell/core-libraries-committee/issues/249 - - - - - edb9bf77 by Jade at 2024-03-09T03:39:38-05:00 Error messages: Improve Error messages for Data constructors in type signatures. This patch improves the error messages from invalid type signatures by trying to guess what the user did and suggesting an appropriate fix. Partially fixes: #17879 - - - - - cfb197e3 by Patrick at 2024-03-09T03:40:15-05:00 HieAst: add module name #24493 The main purpose of this is to tuck the module name `xxx` in `module xxx where` into the hieAst. It should fix #24493. The following have been done: 1. Renamed and update the `tcg_doc_hdr :: Maybe (LHsDoc GhcRn)` to `tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName))` To store the located module name information. 2. update the `RenamedSource` and `RenamedStuff` with extra `Maybe (XRec GhcRn ModuleName)` located module name information. 3. add test `testsuite/tests/hiefile/should_compile/T24493.hs` to ensure the module name is added and update several relevent tests. 4. accompanied submodule haddoc test update MR in https://gitlab.haskell.org/ghc/haddock/-/merge_requests/53 - - - - - 2341d81e by Vaibhav Sagar at 2024-03-09T03:40:54-05:00 GHC.Utils.Binary: fix a couple of typos - - - - - 5580e1bd by Ben Gamari at 2024-03-09T03:41:30-05:00 rts: Drop .wasm suffix from .prof file names This replicates the behavior on Windows, where `Hi.exe` will produce profiling output named `Hi.prof` instead of `Hi.exe.prof`. While in the area I also fixed the extension-stripping logic, which incorrectly rewrote `Hi.exefoo` to `Hi.foo`. Closes #24515. - - - - - 259495ee by Cheng Shao at 2024-03-09T03:41:30-05:00 testsuite: drop exe extension from .hp & .prof filenames See #24515 for details. - - - - - c477a8d2 by Ben Gamari at 2024-03-09T03:42:05-05:00 rts/linker: Enable GOT support on all platforms There is nothing platform-dependent about our GOT implementation and GOT support is needed by `T24171` on i386. - - - - - 2e592857 by Vladislav Zavialov at 2024-03-09T03:42:41-05:00 Drop outdated comment on TcRnIllformedTypePattern This should have been done in 0f0c53a501b but I missed it. - - - - - c554b4da by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/CloneStack: Bounds check array write - - - - - 15c590a5 by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/CloneStack: Don't expose helper functions in header - - - - - e831ce31 by Ben Gamari at 2024-03-09T09:39:20-05:00 base: Move internals of GHC.InfoProv into GHC.InfoProv.Types Such that we can add new helpers into GHC.InfoProv.Types without breakage. - - - - - 6948e24d by Ben Gamari at 2024-03-09T09:39:20-05:00 rts: Lazily decode IPE tables Previously we would eagerly allocate `InfoTableEnt`s for each info table registered in the info table provenance map. However, this costs considerable memory and initialization time. Instead we now lazily decode these tables. This allows us to use one-third the memory *and* opens the door to taking advantage of sharing opportunities within a module. This required considerable reworking since lookupIPE now must be passed its result buffer. - - - - - 9204a04e by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/IPE: Don't expose helper in header - - - - - 308926ff by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/IPE: Share module_name within a Node This allows us to shave a 64-bit word off of the packed IPE entry size. - - - - - bebdea05 by Ben Gamari at 2024-03-09T09:39:20-05:00 IPE: Expose unit ID in InfoTableProv Here we add the unit ID to the info table provenance structure. - - - - - 6519c9ad by Ben Gamari at 2024-03-09T09:39:35-05:00 rts: Refactor GHC.Stack.CloneStack.decode Don't allocate a Ptr constructor per frame. - - - - - ed0b69dc by Ben Gamari at 2024-03-09T09:39:35-05:00 base: Do not expose whereFrom# from GHC.Exts - - - - - 2b1faea9 by Vladislav Zavialov at 2024-03-09T17:38:21-05:00 docs: Update info on TypeAbstractions * Mention TypeAbstractions in 9.10.1-notes.rst * Set the status to "Experimental". * Add a "Since: GHC 9.x" comment to each section. - - - - - f8b88918 by Ben Gamari at 2024-03-09T21:21:46-05:00 ci-images: Bump Alpine image to bootstrap with 9.8.2 - - - - - 705e6927 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Mark T24171 as fragile due to #24512 I will fix this but not in time for 9.10.1-alpha1 - - - - - c74196e1 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Mark linker_unload_native as fragile In particular this fails on platforms without `dlinfo`. I plan to address this but not before 9.10.1-alpha1. - - - - - f4d87f7a by Ben Gamari at 2024-03-09T21:21:46-05:00 configure: Bump version to 9.10 - - - - - 88df9a5f by Ben Gamari at 2024-03-09T21:21:46-05:00 Bump transformers submodule to 0.6.1.1 - - - - - 8176d5e8 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Increase ulimit for T18623 1 MByte was just too tight and failed intermittently on some platforms (e.g. CentOS 7). Bumping the limit to 8 MByte should provide sufficient headroom. Fixes #23139. - - - - - c74b38a3 by Ben Gamari at 2024-03-09T21:21:46-05:00 base: Bump version to 4.20.0.0 - - - - - b2937fc3 by Ben Gamari at 2024-03-09T21:21:46-05:00 ghc-internal: Set initial version at 9.1001.0 This provides PVP compliance while maintaining a clear correspondence between GHC releases and `ghc-internal` versions. - - - - - 4ae7d868 by Ben Gamari at 2024-03-09T21:21:46-05:00 ghc-prim: Bump version to 0.11.0 - - - - - 50798dc6 by Ben Gamari at 2024-03-09T21:21:46-05:00 template-haskell: Bump version to 2.22.0.0 - - - - - 8564f976 by Ben Gamari at 2024-03-09T21:21:46-05:00 base-exports: Accommodate spurious whitespace changes in 32-bit output It appears that this was - - - - - 9d4f0e98 by Ben Gamari at 2024-03-09T21:21:46-05:00 users-guide: Move exception backtrace relnotes to 9.10 This was previously mistakenly added to the GHC 9.8 release notes. - - - - - 145eae60 by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/rel_eng: Fix name of Rocky8 artifact - - - - - 39c2a630 by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/rel_eng: Fix path of generate_jobs_metadata - - - - - aed034de by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/upload: Rework recompression The old `combine` approach was quite fragile due to use of filename globbing. Moreover, it didn't parallelize well. This refactoring makes the goal more obvious, parallelizes better, and is more robust. - - - - - dc207d06 by Ben Gamari at 2024-03-10T08:56:08-04:00 configure: Bump GHC version to 9.11 Bumps haddock submodule. - - - - - 8b2513e8 by Ben Gamari at 2024-03-11T01:20:03-04:00 rts/linker: Don't unload code when profiling is enabled The heap census may contain references (e.g. `Counter.identity`) to static data which must be available when the census is reported at the end of execution. Fixes #24512. - - - - - 7810b4c3 by Ben Gamari at 2024-03-11T01:20:03-04:00 rts/linker: Don't unload native objects when dlinfo isn't available To do so is unsafe as we have no way of identifying references to symbols provided by the object. Fixes #24513. Fixes #23993. - - - - - 0590764c by Ben Gamari at 2024-03-11T01:20:39-04:00 rel_eng/upload: Purge both $rel_name/ and $ver/ This is necessary for prereleases, where GHCup accesses the release via `$ver/` - - - - - b85a4631 by Brandon Chinn at 2024-03-12T19:25:56-04:00 Remove duplicate code normalising slashes - - - - - c91946f9 by Brandon Chinn at 2024-03-12T19:25:56-04:00 Simplify regexes with raw strings - - - - - 1a5f53c6 by Brandon Chinn at 2024-03-12T19:25:57-04:00 Don't normalize backslashes in characters - - - - - 7ea971d3 by Andrei Borzenkov at 2024-03-12T19:26:32-04:00 Fix compiler crash caused by implicit RHS quantification in type synonyms (#24470) - - - - - 39f3ac3e by Cheng Shao at 2024-03-12T19:27:11-04:00 Revert "compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms" This reverts commit 615eb855416ce536e02ed935ecc5a6f25519ae16. It was originally intended to fix #24449, but it was merely sweeping the bug under the rug. 3836a110577b5c9343915fd96c1b2c64217e0082 has properly fixed the fragile test, and we no longer need the C version of genSym. Furthermore, the C implementation causes trouble when compiling with clang that targets i386 due to alignment warning and libatomic linking issue, so it makes sense to revert it. - - - - - e6bfb85c by Cheng Shao at 2024-03-12T19:27:11-04:00 compiler: fix out-of-bound memory access of genSym on 32-bit This commit fixes an unnoticed out-of-bound memory access of genSym on 32-bit. ghc_unique_inc is 32-bit sized/aligned on 32-bit platforms, but we mistakenly treat it as a Word64 pointer in genSym, and therefore will accidentally load 2 garbage higher bytes, or with a small but non-zero chance, overwrite something else in the data section depends on how the linker places the data segments. This regression was introduced in !11802 and fixed here. - - - - - 77171cd1 by Ben Orchard at 2024-03-14T09:00:40-04:00 Note mutability of array and address access primops Without an understanding of immutable vs. mutable memory, the index primop family have a potentially non-intuitive type signature: indexOffAddr :: Addr# -> Int# -> a readOffAddr :: Addr# -> Int# -> State# d -> (# State# d, a #) indexOffAddr# might seem like a free generality improvement, which it certainly is not! This change adds a brief note on mutability expectations for most index/read/write access primops. - - - - - 7da7f8f6 by Alan Zimmerman at 2024-03-14T09:01:15-04:00 EPA: Fix regression discarding comments in contexts Closes #24533 - - - - - 73be65ab by Fendor at 2024-03-19T01:42:53-04:00 Fix sharing of 'IfaceTyConInfo' during core to iface type translation During heap analysis, we noticed that during generation of 'mi_extra_decls' we have lots of duplicates for the instances: * `IfaceTyConInfo NotPromoted IfaceNormalTyCon` * `IfaceTyConInfo IsPromoted IfaceNormalTyCon` which should be shared instead of duplicated. This duplication increased the number of live bytes by around 200MB while loading the agda codebase into GHCi. These instances are created during `CoreToIface` translation, in particular `toIfaceTyCon`. The generated core looks like: toIfaceTyCon = \ tc_sjJw -> case $wtoIfaceTyCon tc_sjJw of { (# ww_sjJz, ww1_sjNL, ww2_sjNM #) -> IfaceTyCon ww_sjJz (IfaceTyConInfo ww1_sjNL ww2_sjNM) } whichs removes causes the sharing to work propery. Adding explicit sharing, with NOINLINE annotations, changes the core to: toIfaceTyCon = \ tc_sjJq -> case $wtoIfaceTyCon tc_sjJq of { (# ww_sjNB, ww1_sjNC #) -> IfaceTyCon ww_sjNB ww1_sjNC } which looks much more like sharing is happening. We confirmed via ghc-debug that all duplications were eliminated and the number of live bytes are noticeably reduced. - - - - - bd8209eb by Alan Zimmerman at 2024-03-19T01:43:28-04:00 EPA: Address more 9.10.1-alpha1 regressions from recent changes Closes #24533 Hopefully for good this time - - - - - 31bf85ee by Fendor at 2024-03-19T14:48:08-04:00 Escape multiple arguments in the settings file Uses responseFile syntax. The issue arises when GHC is installed on windows into a location that has a space, for example the user name is 'Fake User'. The $topdir will also contain a space, consequentially. When we resolve the top dir in the string `-I$topdir/mingw/include`, then `words` will turn this single argument into `-I/C/Users/Fake` and `User/.../mingw/include` which trips up the flag argument parser of various tools such as gcc or clang. We avoid this by escaping the $topdir before replacing it in `initSettngs`. Additionally, we allow to escape spaces and quotation marks for arguments in `settings` file. Add regression test case to count the number of options after variable expansion and argument escaping took place. Additionally, we check that escaped spaces and double quotation marks are correctly parsed. - - - - - f45f700e by Matthew Pickering at 2024-03-19T14:48:44-04:00 Read global package database from settings file Before this patch, the global package database was always assumed to be in libdir </> package.conf.d. This causes issues in GHC's build system because there are sometimes situations where the package database you need to use is not located in the same place as the settings file. * The stage1 compiler needs to use stage1 libraries, so we should set "Global Package DB" for the stage1 compiler to the stage1 package database. * Stage 2 cross compilers need to use stage2 libraries, so likewise, we should set the package database path to `_build/stage2/lib/` * The normal situation is where the stage2 compiler uses stage1 libraries. Then everything lines up. * When installing we have rearranged everything so that the settings file and package database line up properly, so then everything should continue to work as before. In this case we set the relative package db path to `package.conf.d`, so it resolves the same as before. * ghc-pkg needs to be modified as well to look in the settings file fo the package database rather than assuming the global package database location relative to the lib folder. * Cabal/cabal-install will work correctly because they query the global package database using `--print-global-package-db`. A reasonable question is why not generate the "right" settings files in the right places in GHC's build system. In order to do this you would need to engineer wrappers for all executables to point to a specific libdir. There are also situations where the same package db is used by two different compilers with two different settings files (think stage2 cross compiler and stage3 compiler). In short, this 10 line patch allows for some reasonable simplifications in Hadrian at very little cost to anything else. Fixes #24502 - - - - - 4c8f1794 by Matthew Pickering at 2024-03-19T14:48:44-04:00 hadrian: Remove stage1 testsuite wrappers logic Now instead of producing wrappers which pass the global package database argument to ghc and ghc-pkg, we write the location of the correct package database into the settings file so you can just use the intree compiler directly. - - - - - da0d8ba5 by Matthew Craven at 2024-03-19T14:49:20-04:00 Remove unused ghc-internal module "GHC.Internal.Constants" - - - - - b56d2761 by Matthew Craven at 2024-03-19T14:49:20-04:00 CorePrep: Rework lowering of BigNat# literals Don't use bigNatFromWord#, because that's terrible: * We shouldn't have to traverse a linked list at run-time to build a BigNat# literal. That's just silly! * The static List object we have to create is much larger than the actual BigNat#'s contents, bloating code size. * We have to read the corresponding interface file, which causes un-tracked implicit dependencies. (#23942) Instead, encode them into the appropriate platform-dependent sequence of bytes, and generate code that copies these bytes at run-time from an Addr# literal into a new ByteArray#. A ByteArray# literal would be the correct thing to generate, but these are not yet supported; see also #17747. Somewhat surprisingly, this change results in a slight reduction in compiler allocations, averaging around 0.5% on ghc's compiler performance tests, including when compiling programs that contain no bignum literals to begin with. The specific cause of this has not been investigated. Since this lowering no longer reads the interface file for GHC.Num.BigNat, the reasoning in Note [Depend on GHC.Num.Integer] is obsoleted. But the story of un-tracked built-in dependencies remains complex, and Note [Tracking dependencies on primitives] now exists to explain this complexity. Additionally, many empty imports have been modified to refer to this new note and comply with its guidance. Several empty imports necessary for other reasons have also been given brief explanations. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 349ea330 by Fendor at 2024-03-19T14:50:00-04:00 Eliminate thunk in 'IfaceTyCon' Heap analysis showed that `IfaceTyCon` retains a thunk to `IfaceTyConInfo`, defeating the sharing of the most common instances of `IfaceTyConInfo`. We make sure the indirection is removed by adding bang patterns to `IfaceTyCon`. Experimental results on the agda code base, where the `mi_extra_decls` were read from disk: Before this change, we observe around 8654045 instances of: `IfaceTyCon[Name,THUNK_1_0]` But these thunks almost exclusively point to a shared value! Forcing the thunk a little bit more, leads to `ghc-debug` reporting: `IfaceTyCon[Name:Name,IfaceTyConInfo]` and a noticeable reduction of live bytes (on agda ~10%). - - - - - 594bee0b by Krzysztof Gogolewski at 2024-03-19T14:50:36-04:00 Minor misc cleanups - GHC.HsToCore.Foreign.JavaScript: remove dropRuntimeRepArgs; boxed tuples don't take RuntimeRep args - GHC.HsToCore.Foreign.Call: avoid partial pattern matching - GHC.Stg.Unarise: strengthen the assertion; we can assert that non-rubbish literals are unary rather than just non-void - GHC.Tc.Gen.HsType: make sure the fsLit "literal" rule fires - users_guide/using-warnings.rst: remove -Wforall-identifier, now deprecated and does nothing - users_guide/using.rst: fix formatting - andy_cherry/test.T: remove expect_broken_for(23272...), 23272 is fixed The rest are simple cleanups. - - - - - cf55a54b by Ben Gamari at 2024-03-19T14:51:12-04:00 mk/relpath: Fix quoting Previously there were two instances in this script which lacked proper quoting. This resulted in `relpath` invocations in the binary distribution Makefile producing incorrect results on Windows, leading to confusing failures from `sed` and the production of empty package registrations. Fixes #24538. - - - - - 5ff88389 by Bryan Richter at 2024-03-19T14:51:48-04:00 testsuite: Disable T21336a on wasm - - - - - 60023351 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian/bindist: Eliminate extraneous `dirname` invocation Previously we would call `dirname` twice per installed library file. We now instead reuse this result. This helps appreciably on Windows, where processes are quite expensive. - - - - - 616ac300 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian: Package mingw toolchain in expected location This fixes #24525, a regression due to 41cbaf44a6ab5eb9fa676d65d32df8377898dc89. Specifically, GHC expects to find the mingw32 toolchain in the binary distribution root. However, after this patch it was packaged in the `lib/` directory. - - - - - de9daade by Ben Gamari at 2024-03-19T22:33:11-04:00 gitlab/rel_eng: More upload.sh tweaks - - - - - 1dfe12db by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_eng: Drop dead prepare_docs codepath - - - - - dd2d748b by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_env/recompress_all: unxz before recompressing Previously we would rather compress the xz *again*, before in addition compressing it with the desired scheme. Fixes #24545. - - - - - 9d936c57 by Ben Gamari at 2024-03-19T22:33:11-04:00 mk-ghcup-metadata: Fix directory of testsuite tarball As reported in #24546, the `dlTest` artifact should be extracted into the `testsuite` directory. - - - - - 6d398066 by Ben Gamari at 2024-03-19T22:33:11-04:00 ghcup-metadata: Don't populate dlOutput unless necessary ghcup can apparently infer the output name of an artifact from its URL. Consequently, we should only include the `dlOutput` field when it would differ from the filename of `dlUri`. Fixes #24547. - - - - - 576f8b7e by Zubin Duggal at 2024-03-19T22:33:46-04:00 Revert "Apply shellcheck suggestion to SUBST_TOOLDIR" This reverts commit c82770f57977a2b5add6e1378f234f8dd6153392. The shellcheck suggestion is spurious and results in SUBST_TOOLDIR being a no-op. `set` sets positional arguments for bash, but we want to set the variable given as the first autoconf argument. Fixes #24542 Metric decreases because the paths in the settings file are now shorter, so we allocate less when we read the settings file. ------------------------- Metric Decrease: T12425 T13035 T9198 ------------------------- - - - - - cdfe6e01 by Fendor at 2024-03-19T22:34:22-04:00 Compact serialisation of IfaceAppArgs In #24563, we identified that IfaceAppArgs serialisation tags each cons cell element with a discriminator byte. These bytes add up quickly, blowing up interface files considerably when '-fwrite-if-simplified-core' is enabled. We compact the serialisation by writing out the length of 'IfaceAppArgs', followed by serialising the elements directly without any discriminator byte. This improvement can decrease the size of some interface files by up to 35%. - - - - - 97a2bb1c by Simon Peyton Jones at 2024-03-20T17:11:29+00:00 Expand untyped splices in tcPolyExprCheck Fixes #24559 - - - - - 5f275176 by Alan Zimmerman at 2024-03-20T22:44:12-04:00 EPA: Clean up Exactprint helper functions a bit - Introduce a helper lens to compose on `EpAnn a` vs `a` versions - Rename some prime versions of functions back to non-prime They were renamed during the rework - - - - - da2a10ce by Vladislav Zavialov at 2024-03-20T22:44:48-04:00 Type operators in promoteOccName (#24570) Type operators differ from term operators in that they are lexically classified as (type) constructors, not as (type) variables. Prior to this change, promoteOccName did not account for this difference, causing a scoping issue that affected RequiredTypeArguments. type (!@#) = Bool f = idee (!@#) -- Not in scope: ‘!@#’ (BUG) Now we have a special case in promoteOccName to account for this. - - - - - 247fc0fa by Preetham Gujjula at 2024-03-21T10:19:18-04:00 docs: Remove mention of non-existent Ord instance for Complex The documentation for Data.Complex says that the Ord instance for Complex Float is deficient, but there is no Ord instance for Complex a. The Eq instance for Complex Float is similarly deficient, so we use that as an example instead. - - - - - 6fafc51e by Andrei Borzenkov at 2024-03-21T10:19:54-04:00 Fix TH handling in `pat_to_type_pat` function (#24571) There was missing case for `SplicePat` in `pat_to_type_at` function, hence patterns with splicing that checked against `forall->` doesn't work properly because they fall into the "illegal pattern" case. Code example that is now accepted: g :: forall a -> () g $([p| a |]) = () - - - - - 52072f8e by Sylvain Henry at 2024-03-21T21:01:59-04:00 Type-check default declarations before deriving clauses (#24566) See added Note and #24566. Default declarations must be type-checked before deriving clauses. - - - - - 7dfdf3d9 by Sylvain Henry at 2024-03-21T21:02:40-04:00 Lexer: small perf changes - Use unsafeChr because we know our values to be valid - Remove some unnecessary use of `ord` (return Word8 values directly) - - - - - 864922ef by Sylvain Henry at 2024-03-21T21:02:40-04:00 JS: fix some comments - - - - - 3e0b2b1f by Sebastian Graf at 2024-03-21T21:03:16-04:00 Simplifier: Re-do dependency analysis in abstractFloats (#24551) In #24551, we abstracted a string literal binding over a type variable, triggering a CoreLint error when that binding floated to top-level. The solution implemented in this patch fixes this by re-doing dependency analysis on a simplified recursive let binding that is about to be type abstracted, in order to find the minimal set of type variables to abstract over. See wrinkle (AB5) of Note [Floating and type abstraction] for more details. Fixes #24551 - - - - - 8a8ac65a by Matthew Craven at 2024-03-23T00:20:52-04:00 Improve toInteger @Word32 on 64-bit platforms On 64-bit platforms, every Word32 fits in an Int, so we can convert to Int# without having to perform the overflow check integerFromWord# uses internally. - - - - - 0c48f2b9 by Apoorv Ingle at 2024-03-23T00:21:28-04:00 Fix for #24552 (see testcase T24552) Fixes for a bug in desugaring pattern synonyms matches, introduced while working on on expanding `do`-blocks in #18324 The `matchWrapper` unecessarily (and incorrectly) filtered out the default wild patterns in a match. Now the wild pattern alternative is simply ignored by the pm check as its origin is `Generated`. The current code now matches the expected semantics according to the language spec. - - - - - b72705e9 by Simon Peyton Jones at 2024-03-23T00:22:04-04:00 Print more info about kinds in error messages This fixes #24553, where GHC unhelpfully said error: [GHC-83865] • Expected kind ‘* -> * -> *’, but ‘Foo’ has kind ‘* -> * -> *’ See Note [Showing invisible bits of types in error messages] - - - - - 8f7cfc7e by Tristan Cacqueray at 2024-03-23T00:22:44-04:00 docs: remove the don't use float hint This hint is outdated, ``Complex Float`` are now specialised, and the heap space suggestion needs more nuance so it should be explained in the unboxed/storable array documentation. - - - - - 5bd8ed53 by Andreas Klebinger at 2024-03-23T16:18:33-04:00 NCG: Fix a bug in jump shortcutting. When checking if a jump has more than one destination account for the possibility of some jumps not being representable by a BlockId. We do so by having isJumpishInstr return a `Maybe BlockId` where Nothing represents non-BlockId jump destinations. Fixes #24507 - - - - - 8d67f247 by Ben Gamari at 2024-03-23T16:19:09-04:00 docs: Drop old release notes, add for 9.12.1 - - - - - 7db8c992 by Cheng Shao at 2024-03-25T13:45:46-04:00 rts: fix clang compilation on aarch64 This patch fixes function prototypes in ARMOutlineAtomicsSymbols.h which causes "error: address argument to atomic operation must be a pointer to _Atomic type" when compiling with clang on aarch64. - - - - - 237194ce by Sylvain Henry at 2024-03-25T13:46:27-04:00 Lexer: fix imports for Alex 3.5.1 (#24583) - - - - - 810660b7 by Cheng Shao at 2024-03-25T22:19:16-04:00 libffi-tarballs: bump libffi-tarballs submodule to libffi 3.4.6 This commit bumps the libffi-tarballs submodule to libffi 3.4.6, which includes numerous upstream libffi fixes, especially https://github.com/libffi/libffi/issues/760. - - - - - d2ba41e8 by Alan Zimmerman at 2024-03-25T22:19:51-04:00 EPA: do not duplicate comments in signature RHS - - - - - 32a8103f by Rodrigo Mesquita at 2024-03-26T21:16:12-04:00 configure: Use LDFLAGS when trying linkers A user may configure `LDFLAGS` but not `LD`. When choosing a linker, we will prefer `ldd`, then `ld.gold`, then `ld.bfd` -- however, we have to check for a working linker. If either of these fail, we try the next in line. However, we were not considering the `$LDFLAGS` when checking if these linkers worked. So we would pick a linker that does not support the current $LDFLAGS and fail further down the line when we used that linker with those flags. Fixes #24565, where `LDFLAGS=-Wl,-z,pack-relative-relocs` is not supported by `ld.gold` but that was being picked still. - - - - - bf65a7c3 by Rodrigo Mesquita at 2024-03-26T21:16:48-04:00 bindist: Clean xattrs of bin and lib at configure time For issue #21506, we started cleaning the extended attributes of binaries and libraries from the bindist *after* they were installed to workaround notarisation (#17418), as part of `make install`. However, the `ghc-toolchain` binary that is now shipped with the bindist must be run at `./configure` time. Since we only cleaned the xattributes of the binaries and libs after they were installed, in some situations users would be unable to run `ghc-toolchain` from the bindist, failing at configure time (#24554). In this commit we move the xattr cleaning logic to the configure script. Fixes #24554 - - - - - cfeb70d3 by Rodrigo Mesquita at 2024-03-26T21:17:24-04:00 Revert "NCG: Fix a bug in jump shortcutting." This reverts commit 5bd8ed53dcefe10b72acb5729789e19ceb22df66. Fixes #24586 - - - - - 13223f6d by Serge S. Gulin at 2024-03-27T07:28:51-04:00 JS: `h$rts_isProfiled` is removed from `profiling` and left its version at `rts/js/config.js` - - - - - 0acfe391 by Alan Zimmerman at 2024-03-27T07:29:27-04:00 EPA: Do not extend declaration range for trailine zero len semi The lexer inserts virtual semicolons having zero width. Do not use them to extend the list span of items in a list. - - - - - cd0fb82f by Alan Zimmerman at 2024-03-27T19:33:08+00:00 EPA: Fix FamDecl range The span was incorrect if opt_datafam_kind_sig was empty - - - - - f8f384a8 by Ben Gamari at 2024-03-29T01:23:03-04:00 Fix type of _get_osfhandle foreign import Fixes #24601. - - - - - 00d3ecf0 by Alan Zimmerman at 2024-03-29T12:19:10+00:00 EPA: Extend StringLiteral range to include trailing commas This goes slightly against the exact printing philosophy where trailing decorations should be in an annotation, but the practicalities of adding it to the WarningTxt environment, and the problems caused by deviating do not make a more principles approach worthwhile. - - - - - efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 0fde229f by Ben Gamari at 2024-04-04T07:04:58-04:00 testsuite: Introduce template-haskell-exports test - - - - - 0c4a9686 by Luite Stegeman at 2024-04-04T07:05:39-04:00 Update correct counter in bumpTickyAllocd - - - - - 5f085d3a by Fendor at 2024-04-04T14:47:33-04:00 Replace `SizedSeq` with `FlatBag` for flattened structure LinkedLists are notoriously memory ineffiecient when all we do is traversing a structure. As 'UnlinkedBCO' has been identified as a data structure that impacts the overall memory usage of GHCi sessions, we avoid linked lists and prefer flattened structure for storing. We introduce a new memory efficient representation of sequential elements that has special support for the cases: * Empty * Singleton * Tuple Elements This improves sharing in the 'Empty' case and avoids the overhead of 'Array' until its constant overhead is justified. - - - - - 82cfe10c by Fendor at 2024-04-04T14:47:33-04:00 Compact FlatBag array representation `Array` contains three additional `Word`'s we do not need in `FlatBag`. Move `FlatBag` to `SmallArray`. Expand the API of SmallArray by `sizeofSmallArray` and add common traversal functions, such as `mapSmallArray` and `foldMapSmallArray`. Additionally, allow users to force the elements of a `SmallArray` via `rnfSmallArray`. - - - - - 36a75b80 by Andrei Borzenkov at 2024-04-04T14:48:10-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 28009fbc by Matthew Pickering at 2024-04-04T14:48:46-04:00 Fix off by one error in seekBinNoExpand and seekBin - - - - - 9b9e031b by Ben Gamari at 2024-04-04T21:30:08-04:00 compiler: Allow more types in GHCForeignImportPrim For many, many years `GHCForeignImportPrim` has suffered from the rather restrictive limitation of not allowing any non-trivial types in arguments or results. This limitation was justified by the code generator allegely barfing in the presence of such types. However, this restriction appears to originate well before the NCG rewrite and the new NCG does not appear to have any trouble with such types (see the added `T24598` test). Lift this restriction. Fixes #24598. - - - - - 1324b862 by Alan Zimmerman at 2024-04-04T21:30:44-04:00 EPA: Use EpaLocation not SrcSpan in ForeignDecls This allows us to update them for makeDeltaAst in ghc-exactprint - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/default.nix - .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/recompress-all - .gitlab/rel_eng/upload.sh - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/LateCC/OverloadedCalls.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05dea0d5e29bc2b293ae770bd43be01c0d3cf830...1324b8626aeb4dc2d6a04f7605d307ef13d1e0e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05dea0d5e29bc2b293ae770bd43be01c0d3cf830...1324b8626aeb4dc2d6a04f7605d307ef13d1e0e9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 12:11:11 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Fri, 05 Apr 2024 08:11:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fendor/array-bcos Message-ID: <660fea5f18390_180afb9d55d028442@gitlab.mail> Hannes Siebenhandl pushed new branch wip/fendor/array-bcos at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/array-bcos You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 12:15:38 2024 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 05 Apr 2024 08:15:38 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] 59 commits: rts: Fix TSAN_ENABLED CPP guard Message-ID: <660feb6a483e5_180afbbd8580300ce@gitlab.mail> Matthew Pickering pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 0fde229f by Ben Gamari at 2024-04-04T07:04:58-04:00 testsuite: Introduce template-haskell-exports test - - - - - 0c4a9686 by Luite Stegeman at 2024-04-04T07:05:39-04:00 Update correct counter in bumpTickyAllocd - - - - - 5f085d3a by Fendor at 2024-04-04T14:47:33-04:00 Replace `SizedSeq` with `FlatBag` for flattened structure LinkedLists are notoriously memory ineffiecient when all we do is traversing a structure. As 'UnlinkedBCO' has been identified as a data structure that impacts the overall memory usage of GHCi sessions, we avoid linked lists and prefer flattened structure for storing. We introduce a new memory efficient representation of sequential elements that has special support for the cases: * Empty * Singleton * Tuple Elements This improves sharing in the 'Empty' case and avoids the overhead of 'Array' until its constant overhead is justified. - - - - - 82cfe10c by Fendor at 2024-04-04T14:47:33-04:00 Compact FlatBag array representation `Array` contains three additional `Word`'s we do not need in `FlatBag`. Move `FlatBag` to `SmallArray`. Expand the API of SmallArray by `sizeofSmallArray` and add common traversal functions, such as `mapSmallArray` and `foldMapSmallArray`. Additionally, allow users to force the elements of a `SmallArray` via `rnfSmallArray`. - - - - - 36a75b80 by Andrei Borzenkov at 2024-04-04T14:48:10-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 28009fbc by Matthew Pickering at 2024-04-04T14:48:46-04:00 Fix off by one error in seekBinNoExpand and seekBin - - - - - 9b9e031b by Ben Gamari at 2024-04-04T21:30:08-04:00 compiler: Allow more types in GHCForeignImportPrim For many, many years `GHCForeignImportPrim` has suffered from the rather restrictive limitation of not allowing any non-trivial types in arguments or results. This limitation was justified by the code generator allegely barfing in the presence of such types. However, this restriction appears to originate well before the NCG rewrite and the new NCG does not appear to have any trouble with such types (see the added `T24598` test). Lift this restriction. Fixes #24598. - - - - - 1324b862 by Alan Zimmerman at 2024-04-04T21:30:44-04:00 EPA: Use EpaLocation not SrcSpan in ForeignDecls This allows us to update them for makeDeltaAst in ghc-exactprint - - - - - ed3fb50d by Fendor at 2024-04-05T13:14:59+01:00 Refactor the Binary serialisation interface The end goal is to dynamically add deduplication tables for `ModIface` interface serialisation. We identify two main points of interest that make this difficult: 1. UserData hardcodes what `Binary` instances can have deduplication tables. Moreover, it heavily uses partial functions. 2. GHC.Iface.Binary hardcodes the deduplication tables for 'Name' and 'FastString', making it difficult to add more deduplication. Instead of having a single `UserData` record with fields for all the types that can have deduplication tables, we allow to provide custom serialisers for any `Typeable`. These are wrapped in existentials and stored in a `Map` indexed by their respective `TypeRep`. The `Binary` instance of the type to deduplicate still needs to explicitly look up the decoder via `findUserDataReader` and `findUserDataWriter`, which is no worse than the status-quo. `Map` was chosen as microbenchmarks indicate it is the fastest for a small number of keys (< 10). To generalise the deduplication table serialisation mechanism, we introduce the types `ReaderTable` and `WriterTable` which provide a simple interface that is sufficient to implement a general purpose deduplication mechanism for `writeBinIface` and `readBinIface`. This allows us to provide a list of deduplication tables for serialisation that can be extended more easily, for example for `IfaceTyCon`, see the issue https://gitlab.haskell.org/ghc/ghc/-/issues/24540 for more motivation. In addition to ths refactoring, we split `UserData` into `ReaderUserData` and `WriterUserData`, to avoid partial functions. Bump haddock submodule to accomodate for `UserData` split. ------------------------- Metric Increase: T21839c ------------------------- - - - - - 99aa935a by Fendor at 2024-04-05T13:15:13+01:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 19 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d07b410229f3844118c4c211e9998478e0cdbc66...99aa935a7863b8b20d855b09113af1133f47179d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d07b410229f3844118c4c211e9998478e0cdbc66...99aa935a7863b8b20d855b09113af1133f47179d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 12:25:56 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Fri, 05 Apr 2024 08:25:56 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fendor/ifacetype-deduplication Message-ID: <660fedd4d72f3_180afbda816c31940@gitlab.mail> Hannes Siebenhandl pushed new branch wip/fendor/ifacetype-deduplication at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/ifacetype-deduplication You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 12:56:50 2024 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 05 Apr 2024 08:56:50 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/fix_fallthrough Message-ID: <660ff5122a381_180afb1205624374f7@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/fix_fallthrough at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/fix_fallthrough You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 13:13:35 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Fri, 05 Apr 2024 09:13:35 -0400 Subject: [Git][ghc/ghc][wip/fendor/ghc-iface-refact] Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` Message-ID: <660ff8ff1e2f1_180afb149c4f0462b2@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC Commits: adf68fba by Fendor at 2024-04-05T15:13:12+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 12 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -75,7 +75,7 @@ readBinIfaceHeader -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, BinHandle) + -> IO (Fingerprint, ReadBinHandle) readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -137,7 +137,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do mod_iface <- getWithUserData name_cache bh - seekBin bh extFields_p + seekBinReader bh extFields_p extFields <- get bh return mod_iface @@ -148,7 +148,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. -getWithUserData :: Binary a => NameCache -> BinHandle -> IO a +getWithUserData :: Binary a => NameCache -> ReadBinHandle -> IO a getWithUserData name_cache bh = do bh <- getTables name_cache bh get bh @@ -156,7 +156,7 @@ getWithUserData name_cache bh = do -- | Setup a BinHandle to read something written using putWithTables -- -- Reading names has the side effect of adding them into the given NameCache. -getTables :: NameCache -> BinHandle -> IO BinHandle +getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do fsReaderTable <- initFastStringReaderTable nameReaderTable <- (initReadNameCachedBinary name_cache) @@ -192,14 +192,14 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh tag put_ bh (mi_src_hash mod_iface) - extFields_p_p <- tellBin bh + extFields_p_p <- tellBinWriter bh put_ bh extFields_p_p putWithUserData traceBinIface bh mod_iface - extFields_p <- tellBin bh + extFields_p <- tellBinWriter bh putAt bh extFields_p_p extFields_p - seekBin bh extFields_p + seekBinWriter bh extFields_p put_ bh (mi_ext_fields mod_iface) -- And send the result to the file @@ -209,7 +209,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do -- is necessary if you want to serialise Names or FastStrings. -- It also writes a symbol table and the dictionary. -- This segment should be read using `getWithUserData`. -putWithUserData :: Binary a => TraceBinIFace -> BinHandle -> a -> IO () +putWithUserData :: Binary a => TraceBinIFace -> WriteBinHandle -> a -> IO () putWithUserData traceBinIface bh payload = do (name_count, fs_count, _b) <- putWithTables bh (\bh' -> put bh' payload) @@ -234,7 +234,7 @@ putWithUserData traceBinIface bh payload = do -- It returns (number of names, number of FastStrings, payload write result) -- -- See Note [Iface Binary Serialiser Order] -putWithTables :: BinHandle -> (BinHandle -> IO b) -> IO (Int, Int, b) +putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) putWithTables bh' put_payload = do (fast_wt, fsWriter) <- initFastStringWriterTable (name_wt, nameWriter) <- initWriteNameTable @@ -374,7 +374,7 @@ initWriteNameTable = do ) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) @@ -383,7 +383,7 @@ putSymbolTable bh name_count symtab = do mapM_ (\n -> serialiseName bh n symtab) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache @@ -404,7 +404,7 @@ getSymbolTable bh name_cache = do arr <- unsafeFreeze mut_arr return (cache, arr) -serialiseName :: BinHandle -> Name -> UniqFM key (Int,Name) -> IO () +serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () serialiseName bh name _ = do let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) put_ bh (moduleUnit mod, moduleName mod, nameOccName name) @@ -428,7 +428,7 @@ serialiseName bh name _ = do -- See Note [Symbol table representation of names] -putName :: BinSymbolTable -> BinHandle -> Name -> IO () +putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO () putName BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } @@ -454,7 +454,7 @@ putName BinSymbolTable{ -- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name - -> BinHandle -> IO Name + -> ReadBinHandle -> IO Name getSymtabName symtab bh = do i :: Word32 <- get bh case i .&. 0xC0000000 of ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -67,7 +67,7 @@ hieMagicLen = length hieMagic ghcVersion :: ByteString ghcVersion = BSC.pack cProjectVersion -putBinLine :: BinHandle -> ByteString -> IO () +putBinLine :: WriteBinHandle -> ByteString -> IO () putBinLine bh xs = do mapM_ (putByte bh) $ BS.unpack xs putByte bh 10 -- newline char @@ -85,11 +85,11 @@ writeHieFile hie_file_path hiefile = do putBinLine bh0 $ ghcVersion -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 + dict_p_p <- tellBinWriter bh0 put_ bh0 dict_p_p -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 + symtab_p_p <- tellBinWriter bh0 put_ bh0 symtab_p_p -- Make some initial state @@ -112,9 +112,9 @@ writeHieFile hie_file_path hiefile = do put_ bh hiefile -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh + symtab_p <- tellBinWriter bh putAt bh symtab_p_p symtab_p - seekBin bh symtab_p + seekBinWriter bh symtab_p -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next @@ -122,9 +122,9 @@ writeHieFile hie_file_path hiefile = do putSymbolTable bh symtab_next' symtab_map' -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh + dict_p <- tellBinWriter bh putAt bh dict_p_p dict_p - seekBin bh dict_p + seekBinWriter bh dict_p -- write the dictionary itself dict_next <- readFastMutInt dict_next_ref @@ -182,7 +182,7 @@ readHieFile name_cache file = do hieFile <- readHieFileContents bh0 name_cache return $ HieFileResult hieVersion ghcVersion hieFile -readBinLine :: BinHandle -> IO ByteString +readBinLine :: ReadBinHandle -> IO ByteString readBinLine bh = BS.pack . reverse <$> loop [] where loop acc = do @@ -191,7 +191,7 @@ readBinLine bh = BS.pack . reverse <$> loop [] then return acc else loop (char : acc) -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader readHieFileHeader file bh0 = do -- Read the header magic <- replicateM hieMagicLen (get bh0) @@ -214,7 +214,7 @@ readHieFileHeader file bh0 = do ] return (readHieVersion, ghcVersion) -readHieFileContents :: BinHandle -> NameCache -> IO HieFile +readHieFileContents :: ReadBinHandle -> NameCache -> IO HieFile readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data @@ -233,21 +233,21 @@ readHieFileContents bh0 name_cache = do where get_dictionary bin_handle = do dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p + data_p <- tellBinReader bin_handle + seekBinReader bin_handle dict_p dict <- getDictionary bin_handle - seekBin bin_handle data_p + seekBinReader bin_handle data_p return dict get_symbol_table bh1 = do symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p + data_p' <- tellBinReader bh1 + seekBinReader bh1 symtab_p symtab <- getSymbolTable bh1 name_cache - seekBin bh1 data_p' + seekBinReader bh1 data_p' return symtab -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () +putFastString :: HieDictionary -> WriteBinHandle -> FastString -> IO () putFastString HieDictionary { hie_dict_next = j_r, hie_dict_map = out_r} bh f = do @@ -261,13 +261,13 @@ putFastString HieDictionary { hie_dict_next = j_r, writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM_Directly out unique (j, f) -putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () +putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,HieName) -> IO () putSymbolTable bh next_off symtab = do put_ bh next_off let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) mapM_ (putHieName bh) names -getSymbolTable :: BinHandle -> NameCache -> IO (SymbolTable Name) +getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh mut_arr <- A.newArray_ (0, sz-1) :: IO (A.IOArray Int Name) @@ -277,12 +277,12 @@ getSymbolTable bh name_cache = do A.writeArray mut_arr i name A.unsafeFreeze mut_arr -getSymTabName :: SymbolTable Name -> BinHandle -> IO Name +getSymTabName :: SymbolTable Name -> ReadBinHandle -> IO Name getSymTabName st bh = do i :: Word32 <- get bh return $ st A.! (fromIntegral i) -putName :: HieSymbolTable -> BinHandle -> Name -> IO () +putName :: HieSymbolTable -> WriteBinHandle -> Name -> IO () putName (HieSymbolTable next ref) bh name = do symmap <- readIORef ref case lookupUFM symmap name of @@ -335,7 +335,7 @@ fromHieName nc hie_name = do -- ** Reading and writing `HieName`'s -putHieName :: BinHandle -> HieName -> IO () +putHieName :: WriteBinHandle -> HieName -> IO () putHieName bh (ExternalName mod occ span) = do putByte bh 0 put_ bh (mod, occ, BinSrcSpan span) @@ -346,7 +346,7 @@ putHieName bh (KnownKeyName uniq) = do putByte bh 2 put_ bh $ unpkUnique uniq -getHieName :: BinHandle -> IO HieName +getHieName :: ReadBinHandle -> IO HieName getHieName bh = do t <- getByte bh case t of ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -33,16 +33,16 @@ instance Binary ExtensibleFields where -- for a payload pointer after each name: header_entries <- forM (Map.toList fs) $ \(name, dat) -> do put_ bh name - field_p_p <- tellBin bh + field_p_p <- tellBinWriter bh put_ bh field_p_p return (field_p_p, dat) -- Now put the payloads and use the reserved space -- to point to the start of each payload: forM_ header_entries $ \(field_p_p, dat) -> do - field_p <- tellBin bh + field_p <- tellBinWriter bh putAt bh field_p_p field_p - seekBin bh field_p + seekBinWriter bh field_p put_ bh dat get bh = do @@ -54,7 +54,7 @@ instance Binary ExtensibleFields where -- Seek to and get each field's payload: fields <- forM header_entries $ \(name, field_p) -> do - seekBin bh field_p + seekBinReader bh field_p dat <- get bh return (name, dat) @@ -72,7 +72,7 @@ emptyExtensibleFields = ExtensibleFields Map.empty readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) readField name = readFieldWith name get -readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> Map.lookup name (getExtensibleFields fields) @@ -82,7 +82,7 @@ readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields writeField name x = writeFieldWith name (`put_` x) -writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields writeFieldWith name write fields = do bh <- openBinMem (1024 * 1024) write bh ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -1032,7 +1032,7 @@ addFingerprints hsc_env iface0 -- change if the fingerprint for anything it refers to (transitively) -- changes. mk_put_name :: OccEnv (OccName,Fingerprint) - -> BinHandle -> Name -> IO () + -> WriteBinHandle -> Name -> IO () mk_put_name local_env bh name | isWiredInName name = putNameLiterally bh name -- wired-in names don't have fingerprints ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain -fingerprintBinMem :: BinHandle -> IO Fingerprint +fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f where f bs = @@ -26,7 +26,7 @@ fingerprintBinMem bh = withBinBuffer bh f in fp `seq` return fp computeFingerprint :: (Binary a) - => (BinHandle -> Name -> IO ()) + => (WriteBinHandle -> Name -> IO ()) -> a -> IO Fingerprint computeFingerprint put_nonbinding_name a = do @@ -39,7 +39,7 @@ computeFingerprint put_nonbinding_name a = do -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. -putNameLiterally :: BinHandle -> Name -> IO () +putNameLiterally :: WriteBinHandle -> Name -> IO () putNameLiterally bh name = assert (isExternalName name) $ do put_ bh $! nameModule name put_ bh $! nameOccName name ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -31,7 +31,7 @@ import System.FilePath (normalise) -- NB: The 'Module' parameter is the 'Module' recorded by the *interface* -- file, not the actual 'Module' according to our 'DynFlags'. fingerprintDynFlags :: HscEnv -> Module - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintDynFlags hsc_env this_mod nameio = @@ -81,7 +81,7 @@ fingerprintDynFlags hsc_env this_mod nameio = -- object files as they can. -- See Note [Ignoring some flag changes] fingerprintOptFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintOptFlags DynFlags{..} nameio = let @@ -99,7 +99,7 @@ fingerprintOptFlags DynFlags{..} nameio = -- file compiled for HPC when not actually using HPC. -- See Note [Ignoring some flag changes] fingerprintHpcFlags :: DynFlags - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -> IO Fingerprint fingerprintHpcFlags dflags at DynFlags{..} nameio = let ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -119,10 +119,10 @@ type IfaceTopBndr = Name -- We don't serialise the namespace onto the disk though; rather we -- drop it when serialising and add it back in when deserialising. -getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr +getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr getIfaceTopBndr bh = get bh -putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO () +putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO () putIfaceTopBndr bh name = case findUserDataWriter (Proxy @BindingName) bh of tbl -> @@ -2445,13 +2445,13 @@ instance Binary IfGuidance where c <- get bh return (IfWhen a b c) -putUnfoldingCache :: BinHandle -> IfUnfoldingCache -> IO () +putUnfoldingCache :: WriteBinHandle -> IfUnfoldingCache -> IO () putUnfoldingCache bh (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) = do let b = zeroBits .<<|. hnf .<<|. conlike .<<|. wf .<<|. exp putByte bh b -getUnfoldingCache :: BinHandle -> IO IfUnfoldingCache +getUnfoldingCache :: ReadBinHandle -> IO IfUnfoldingCache getUnfoldingCache bh = do b <- getByte bh let hnf = testBit b 3 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -89,10 +89,10 @@ import GHC.Utils.Misc import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) -import Data.Maybe( isJust ) -import qualified Data.Semigroup as Semi import Control.DeepSeq -import Control.Monad +import Control.Monad ((<$!>)) +import qualified Data.Semigroup as Semi +import Data.Maybe( isJust ) {- ************************************************************************ ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -168,7 +168,7 @@ wasmHeader = unsafePerformIO $ B.unsafePackAddressLen 4 "\0asm"# data Object = Object { objModuleName :: !ModuleName -- ^ name of the module - , objHandle :: !BinHandle + , objHandle :: !ReadBinHandle -- ^ BinHandle that can be used to read the ObjBlocks , objPayloadOffset :: !(Bin ObjBlock) -- ^ Offset of the payload (units) @@ -253,7 +253,7 @@ instance Outputable ExportedFun where -- | Write an ObjBlock, except for the top level symbols which are stored in the -- index -putObjBlock :: BinHandle -> ObjBlock -> IO () +putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do put_ bh b put_ bh c @@ -264,7 +264,7 @@ putObjBlock bh (ObjBlock _syms b c d e f g) = do -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) -getObjBlock :: [FastString] -> BinHandle -> IO ObjBlock +getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do b <- get bh c <- get bh @@ -299,7 +299,7 @@ data IndexEntry = IndexEntry -- | Given a handle to a Binary payload, add the module, 'mod_name', its -- dependencies, 'deps', and its linkable units to the payload. putObject - :: BinHandle + :: WriteBinHandle -> ModuleName -- ^ module -> BlockInfo -- ^ block infos -> [ObjBlock] -- ^ linkable units and their symbols @@ -322,7 +322,7 @@ putObject bh mod_name deps os = do -- forward put the index forwardPut_ bh_fs (put_ bh_fs) $ do idx <- forM os $ \o -> do - p <- tellBin bh_fs + p <- tellBinWriter bh_fs -- write units without their symbols putObjBlock bh_fs o -- return symbols and offset to store in the index @@ -330,7 +330,7 @@ putObject bh mod_name deps os = do pure idx -- | Parse object header -getObjectHeader :: BinHandle -> IO (Either String ModuleName) +getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName) getObjectHeader bh = do magic <- getByteString bh (B.length hsHeader) case magic == hsHeader of @@ -345,7 +345,7 @@ getObjectHeader bh = do -- | Parse object body. Must be called after a successful getObjectHeader -getObjectBody :: BinHandle -> ModuleName -> IO Object +getObjectBody :: ReadBinHandle -> ModuleName -> IO Object getObjectBody bh0 mod_name = do -- Read the string table dict <- forwardGet bh0 (getDictionary bh0) @@ -353,7 +353,7 @@ getObjectBody bh0 mod_name = do block_info <- get bh idx <- forwardGet bh (get bh) - payload_pos <- tellBin bh + payload_pos <- tellBinReader bh pure $ Object { objModuleName = mod_name @@ -364,7 +364,7 @@ getObjectBody bh0 mod_name = do } -- | Parse object -getObject :: BinHandle -> IO (Maybe Object) +getObject :: ReadBinHandle -> IO (Maybe Object) getObject bh = do getObjectHeader bh >>= \case Left _err -> pure Nothing @@ -393,7 +393,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..]) bh = objHandle obj read_entry (IndexEntry syms offset,i) | IS.member i bids = do - seekBin bh offset + seekBinReader bh offset Just <$> getObjBlock syms bh | otherwise = pure Nothing @@ -409,12 +409,12 @@ readObjectBlocks file bids = do -- Helper functions -------------------------------------------------------------------------------- -putEnum :: Enum a => BinHandle -> a -> IO () +putEnum :: Enum a => WriteBinHandle -> a -> IO () putEnum bh x | n > 65535 = error ("putEnum: out of range: " ++ show n) | otherwise = put_ bh n where n = fromIntegral $ fromEnum x :: Word16 -getEnum :: Enum a => BinHandle -> IO a +getEnum :: Enum a => ReadBinHandle -> IO a getEnum bh = toEnum . fromIntegral <$> (get bh :: IO Word16) -- | Helper to convert Int to Int32 @@ -779,7 +779,7 @@ writeJSObject opts contents output_fn = do -- | Read a JS object from BinHandle -parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString) +parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString) parseJSObject bh = do magic <- getByteString bh (B.length jsHeader) case magic == jsHeader of ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Utils.Binary ( {-type-} Bin, {-class-} Binary(..), - {-type-} BinHandle, + {-type-} ReadBinHandle, WriteBinHandle, SymbolTable, Dictionary, BinData(..), dataHandle, handleData, @@ -31,8 +31,10 @@ module GHC.Utils.Binary openBinMem, -- closeBin, - seekBin, - tellBin, + seekBinWriter, + seekBinReader, + tellBinReader, + tellBinWriter, castBin, withBinBuffer, @@ -85,7 +87,6 @@ module GHC.Utils.Binary initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, - -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..), -- * Newtypes for types that have canonically more than one valid encoding @@ -172,70 +173,91 @@ instance Binary BinData where copyBytes dest orig sz return (BinData sz dat) -dataHandle :: BinData -> IO BinHandle +dataHandle :: BinData -> IO ReadBinHandle dataHandle (BinData size bin) = do ixr <- newFastMutInt 0 - szr <- newFastMutInt size - binr <- newIORef bin - return (BinMem noReaderUserData noWriterUserData ixr szr binr) + return (ReadBinMem noReaderUserData ixr size bin) -handleData :: BinHandle -> IO BinData -handleData (BinMem _ _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr +handleData :: WriteBinHandle -> IO BinData +handleData (WriteBinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- -data BinHandle - = BinMem { -- binary data stored in an unboxed array - bh_reader :: ReaderUserData, -- sigh, need parameterized modules :-) - bh_writer :: WriterUserData, -- sigh, need parameterized modules :-) - _off_r :: !FastMutInt, -- the current offset - _sz_r :: !FastMutInt, -- size of the array (cached) - _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) +-- | A write-only handle that can be used to serialise binary data into a buffer. +-- +-- The buffer is an unboxed binary array. +data WriteBinHandle + = WriteBinMem { + wbm_userData :: WriterUserData, + -- ^ User data for writing binary outputs. + -- Allows users to overwrite certain 'Binary' instances. + -- This is helpful when a non-canonical 'Binary' instance is required, + -- such as in the case of 'Name'. + wbm_off_r :: !FastMutInt, -- ^ the current offset + wbm_sz_r :: !FastMutInt, -- ^ size of the array (cached) + wbm_arr_r :: !(IORef BinArray) -- ^ the array (bounds: (0,size-1)) + } + +-- | A read-only handle that can be used to deserialise binary data from a buffer. +-- +-- The buffer is an unboxed binary array. +data ReadBinHandle + = ReadBinMem { + rbm_userData :: ReaderUserData, + -- ^ User data for reading binary inputs. + -- Allows users to overwrite certain 'Binary' instances. + -- This is helpful when a non-canonical 'Binary' instance is required, + -- such as in the case of 'Name'. + rbm_off_r :: !FastMutInt, -- ^ the current offset + rbm_sz_r :: !Int, -- ^ size of the array (cached) + rbm_arr_r :: !BinArray -- ^ the array (bounds: (0,size-1)) } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. -getReaderUserData :: BinHandle -> ReaderUserData -getReaderUserData bh = bh_reader bh +getReaderUserData :: ReadBinHandle -> ReaderUserData +getReaderUserData bh = rbm_userData bh -getWriterUserData :: BinHandle -> WriterUserData -getWriterUserData bh = bh_writer bh +getWriterUserData :: WriteBinHandle -> WriterUserData +getWriterUserData bh = wbm_userData bh -setWriterUserData :: BinHandle -> WriterUserData -> BinHandle -setWriterUserData bh us = bh { bh_writer = us } +setWriterUserData :: WriteBinHandle -> WriterUserData -> WriteBinHandle +setWriterUserData bh us = bh { wbm_userData = us } -setReaderUserData :: BinHandle -> ReaderUserData -> BinHandle -setReaderUserData bh us = bh { bh_reader = us } +setReaderUserData :: ReadBinHandle -> ReaderUserData -> ReadBinHandle +setReaderUserData bh us = bh { rbm_userData = us } -addReaderToUserData :: SomeBinaryReader -> BinHandle -> BinHandle +-- | Add 'SomeBinaryReader' as a known binary decoder. +-- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', +-- it is overwritten. +addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh - { bh_reader = (bh_reader bh) - { ud_reader_data = Map.insert typRep cache (ud_reader_data (bh_reader bh)) + { rbm_userData = (rbm_userData bh) + { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) } } -addWriterToUserData :: SomeBinaryWriter -> BinHandle -> BinHandle +-- | Add 'SomeBinaryWriter' as a known binary encoder. +-- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', +-- it is overwritten. +addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh - { bh_writer = (bh_writer bh) - { ud_writer_data = Map.insert typRep cache (ud_writer_data (bh_writer bh)) + { wbm_userData = (wbm_userData bh) + { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) } } -- | Get access to the underlying buffer. -withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a -withBinBuffer (BinMem _ _ ix_r _ arr_r) action = do - arr <- readIORef arr_r +withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a +withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r + arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix -unsafeUnpackBinBuffer :: ByteString -> IO BinHandle +unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt len - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return (ReadBinMem noReaderUserData ix_r len arr) --------------------------------------------------------------- -- Bin @@ -254,23 +276,23 @@ castBin (BinPtr i) = BinPtr i -- | Do not rely on instance sizes for general types, -- we use variable length encoding for many of them. class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a + put_ :: WriteBinHandle -> a -> IO () + put :: WriteBinHandle -> a -> IO (Bin a) + get :: ReadBinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do _ <- put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p + put bh a = do p <- tellBinWriter bh; put_ bh a; return p -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put_ bh x; return () +putAt :: Binary a => WriteBinHandle -> Bin a -> a -> IO () +putAt bh p x = do seekBinWriter bh p; put_ bh x; return () -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh +getAt :: Binary a => ReadBinHandle -> Bin a -> IO a +getAt bh p = do seekBinReader bh p; get bh -openBinMem :: Int -> IO BinHandle +openBinMem :: Int -> IO WriteBinHandle openBinMem size | size <= 0 = error "GHC.Utils.Binary.openBinMem: size must be >= 0" | otherwise = do @@ -278,45 +300,60 @@ openBinMem size arr_r <- newIORef arr ix_r <- newFastMutInt 0 sz_r <- newFastMutInt size - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return WriteBinMem + { wbm_userData = noWriterUserData + , wbm_off_r = ix_r + , wbm_sz_r = sz_r + , wbm_arr_r = arr_r + } -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinMem _ _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) +tellBinWriter :: WriteBinHandle -> IO (Bin a) +tellBinWriter (WriteBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) -seekBin :: BinHandle -> Bin a -> IO () -seekBin h@(BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +tellBinReader :: ReadBinHandle -> IO (Bin a) +tellBinReader (ReadBinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) + +seekBinWriter :: WriteBinHandle -> Bin a -> IO () +seekBinWriter h@(WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p > sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p --- | 'seekBinNoExpand' moves the index pointer to the location pointed to +-- | 'seekBinNoExpandWriter' moves the index pointer to the location pointed to -- by 'Bin a'. -- This operation may 'panic', if the pointer location is out of bounds of the -- buffer of 'BinHandle'. -seekBinNoExpand :: BinHandle -> Bin a -> IO () -seekBinNoExpand (BinMem _ _ ix_r sz_r _) (BinPtr !p) = do +seekBinNoExpandWriter :: WriteBinHandle -> Bin a -> IO () +seekBinNoExpandWriter (WriteBinMem _ ix_r sz_r _) (BinPtr !p) = do sz <- readFastMutInt sz_r if (p > sz) - then panic "seekBinNoExpand: seek out of range" + then panic "seekBinNoExpandWriter: seek out of range" + else writeFastMutInt ix_r p + +-- | SeekBin but without calling expandBin +seekBinReader :: ReadBinHandle -> Bin a -> IO () +seekBinReader (ReadBinMem _ ix_r sz_r _) (BinPtr !p) = do + if (p > sz_r) + then panic "seekBinReader: seek out of range" else writeFastMutInt ix_r p -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinMem _ _ ix_r _ arr_r) fn = do +writeBinMem :: WriteBinHandle -> FilePath -> IO () +writeBinMem (WriteBinMem _ ix_r _ arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix hClose h -readBinMem :: FilePath -> IO BinHandle +readBinMem :: FilePath -> IO ReadBinHandle readBinMem filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h let filesize = fromIntegral filesize' readBinMem_ filesize h -readBinMemN :: Int -> FilePath -> IO (Maybe BinHandle) +readBinMemN :: Int -> FilePath -> IO (Maybe ReadBinHandle) readBinMemN size filename = do withBinaryFile filename ReadMode $ \h -> do filesize' <- hFileSize h @@ -325,20 +362,23 @@ readBinMemN size filename = do then pure Nothing else Just <$> readBinMem_ size h -readBinMem_ :: Int -> Handle -> IO BinHandle +readBinMem_ :: Int -> Handle -> IO ReadBinHandle readBinMem_ filesize h = do arr <- mallocForeignPtrBytes filesize count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize when (count /= filesize) $ error ("Binary.readBinMem: only read " ++ show count ++ " bytes") - arr_r <- newIORef arr ix_r <- newFastMutInt 0 - sz_r <- newFastMutInt filesize - return (BinMem noReaderUserData noWriterUserData ix_r sz_r arr_r) + return ReadBinMem + { rbm_userData = noReaderUserData + , rbm_off_r = ix_r + , rbm_sz_r = filesize + , rbm_arr_r = arr + } -- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ _ sz_r arr_r) !off = do +expandBin :: WriteBinHandle -> Int -> IO () +expandBin (WriteBinMem _ _ sz_r arr_r) !off = do !sz <- readFastMutInt sz_r let !sz' = getSize sz arr <- readIORef arr_r @@ -359,7 +399,7 @@ expandBin (BinMem _ _ _ sz_r arr_r) !off = do foldGet :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -375,7 +415,7 @@ foldGet n bh init_b f = go 0 init_b foldGet' :: Binary a => Word -- n elements - -> BinHandle + -> ReadBinHandle -> b -- initial accumulator -> (Word -> a -> b -> IO b) -> IO b @@ -396,8 +436,8 @@ foldGet' n bh init_b f = go 0 init_b -- | Takes a size and action writing up to @size@ bytes. -- After the action has run advance the index to the buffer -- by size bytes. -putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () -putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do +putPrim :: WriteBinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO () +putPrim h@(WriteBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix + size > sz) $ @@ -418,39 +458,37 @@ putPrim h@(BinMem _ _ ix_r sz_r arr_r) size f = do -- written <- withForeignPtr arr $ \op -> f (op `plusPtr` ix) -- writeFastMutInt ix_r (ix + written) -getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a -getPrim (BinMem _ _ ix_r sz_r arr_r) size f = do +getPrim :: ReadBinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a +getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r - when (ix + size > sz) $ + when (ix + size > sz_r) $ ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing) - arr <- readIORef arr_r - w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix) + w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix) -- This is safe WRT #17760 as we we guarantee that the above line doesn't -- diverge writeFastMutInt ix_r (ix + size) return w -putWord8 :: BinHandle -> Word8 -> IO () +putWord8 :: WriteBinHandle -> Word8 -> IO () putWord8 h !w = putPrim h 1 (\op -> poke op w) -getWord8 :: BinHandle -> IO Word8 +getWord8 :: ReadBinHandle -> IO Word8 getWord8 h = getPrim h 1 peek -putWord16 :: BinHandle -> Word16 -> IO () +putWord16 :: WriteBinHandle -> Word16 -> IO () putWord16 h w = putPrim h 2 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 8)) pokeElemOff op 1 (fromIntegral (w .&. 0xFF)) ) -getWord16 :: BinHandle -> IO Word16 +getWord16 :: ReadBinHandle -> IO Word16 getWord16 h = getPrim h 2 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 return $! w0 `shiftL` 8 .|. w1 ) -putWord32 :: BinHandle -> Word32 -> IO () +putWord32 :: WriteBinHandle -> Word32 -> IO () putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 24)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF)) @@ -458,7 +496,7 @@ putWord32 h w = putPrim h 4 (\op -> do pokeElemOff op 3 (fromIntegral (w .&. 0xFF)) ) -getWord32 :: BinHandle -> IO Word32 +getWord32 :: ReadBinHandle -> IO Word32 getWord32 h = getPrim h 4 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -471,7 +509,7 @@ getWord32 h = getPrim h 4 (\op -> do w3 ) -putWord64 :: BinHandle -> Word64 -> IO () +putWord64 :: WriteBinHandle -> Word64 -> IO () putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 0 (fromIntegral (w `shiftR` 56)) pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF)) @@ -483,7 +521,7 @@ putWord64 h w = putPrim h 8 (\op -> do pokeElemOff op 7 (fromIntegral (w .&. 0xFF)) ) -getWord64 :: BinHandle -> IO Word64 +getWord64 :: ReadBinHandle -> IO Word64 getWord64 h = getPrim h 8 (\op -> do w0 <- fromIntegral <$> peekElemOff op 0 w1 <- fromIntegral <$> peekElemOff op 1 @@ -504,10 +542,10 @@ getWord64 h = getPrim h 8 (\op -> do w7 ) -putByte :: BinHandle -> Word8 -> IO () +putByte :: WriteBinHandle -> Word8 -> IO () putByte bh !w = putWord8 bh w -getByte :: BinHandle -> IO Word8 +getByte :: ReadBinHandle -> IO Word8 getByte h = getWord8 h -- ----------------------------------------------------------------------------- @@ -530,15 +568,15 @@ getByte h = getWord8 h -- for now. -- Unsigned numbers -{-# SPECIALISE putULEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putULEB128 :: BinHandle -> Int16 -> IO () #-} -putULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> a -> IO () +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putULEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putULEB128 :: forall a. (Integral a, FiniteBits a) => WriteBinHandle -> a -> IO () putULEB128 bh w = #if defined(DEBUG) (if w < 0 then panic "putULEB128: Signed number" else id) $ @@ -555,15 +593,15 @@ putULEB128 bh w = putByte bh byte go (w `unsafeShiftR` 7) -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getULEB128 :: BinHandle -> IO Int16 #-} -getULEB128 :: forall a. (Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getULEB128 :: ReadBinHandle -> IO Int16 #-} +getULEB128 :: forall a. (Integral a, FiniteBits a) => ReadBinHandle -> IO a getULEB128 bh = go 0 0 where @@ -579,15 +617,15 @@ getULEB128 bh = return $! val -- Signed numbers -{-# SPECIALISE putSLEB128 :: BinHandle -> Word -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Word16 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int64 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int32 -> IO () #-} -{-# SPECIALISE putSLEB128 :: BinHandle -> Int16 -> IO () #-} -putSLEB128 :: forall a. (Integral a, Bits a) => BinHandle -> a -> IO () +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Word16 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-} +{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-} +putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO () putSLEB128 bh initial = go initial where go :: a -> IO () @@ -607,15 +645,15 @@ putSLEB128 bh initial = go initial unless done $ go val' -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Word16 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int64 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int32 #-} -{-# SPECIALISE getSLEB128 :: BinHandle -> IO Int16 #-} -getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => BinHandle -> IO a +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Word16 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int64 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int32 #-} +{-# SPECIALISE getSLEB128 :: ReadBinHandle -> IO Int16 #-} +getSLEB128 :: forall a. (Show a, Integral a, FiniteBits a) => ReadBinHandle -> IO a getSLEB128 bh = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) @@ -1026,63 +1064,63 @@ instance Binary (Bin a) where -- | "forwardPut put_A put_B" outputs A after B but allows A to be read before B -- by using a forward reference -forwardPut :: BinHandle -> (b -> IO a) -> IO b -> IO (a,b) +forwardPut :: WriteBinHandle -> (b -> IO a) -> IO b -> IO (a,b) forwardPut bh put_A put_B = do -- write placeholder pointer to A - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- write B r_b <- put_B -- update A's pointer - a <- tellBin bh + a <- tellBinWriter bh putAt bh pre_a a - seekBinNoExpand bh a + seekBinNoExpandWriter bh a -- write A r_a <- put_A r_b pure (r_a,r_b) -forwardPut_ :: BinHandle -> (b -> IO a) -> IO b -> IO () +forwardPut_ :: WriteBinHandle -> (b -> IO a) -> IO b -> IO () forwardPut_ bh put_A put_B = void $ forwardPut bh put_A put_B -- | Read a value stored using a forward reference -forwardGet :: BinHandle -> IO a -> IO a +forwardGet :: ReadBinHandle -> IO a -> IO a forwardGet bh get_A = do -- read forward reference p <- get bh -- a BinPtr -- store current position - p_a <- tellBin bh + p_a <- tellBinReader bh -- go read the forward value, then seek back - seekBinNoExpand bh p + seekBinReader bh p r <- get_A - seekBinNoExpand bh p_a + seekBinReader bh p_a pure r -- ----------------------------------------------------------------------------- -- Lazy reading/writing -lazyPut :: Binary a => BinHandle -> a -> IO () +lazyPut :: Binary a => WriteBinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh + pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object + q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q + seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => BinHandle -> IO a +lazyGet :: Binary a => ReadBinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr - p_a <- tellBin bh + p_a <- tellBinReader bh a <- unsafeInterleaveIO $ do -- NB: Use a fresh off_r variable in the child thread, for thread -- safety. off_r <- newFastMutInt 0 - getAt bh { _off_r = off_r } p_a - seekBin bh p -- skip over the object for now + getAt bh { rbm_off_r = off_r } p_a + seekBinReader bh p -- skip over the object for now return a -- | Serialize the constructor strictly but lazily serialize a value inside a @@ -1090,14 +1128,14 @@ lazyGet bh = do -- -- This way we can check for the presence of a value without deserializing the -- value itself. -lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe :: Binary a => WriteBinHandle -> Maybe a -> IO () lazyPutMaybe bh Nothing = putWord8 bh 0 lazyPutMaybe bh (Just x) = do putWord8 bh 1 lazyPut bh x -- | Deserialize a value serialized by 'lazyPutMaybe'. -lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe :: Binary a => ReadBinHandle -> IO (Maybe a) lazyGetMaybe bh = do h <- getWord8 bh case h of @@ -1192,19 +1230,19 @@ mkSomeBinaryReader :: forall a . Typeable a => BinaryReader a -> SomeBinaryReade mkSomeBinaryReader cb = SomeBinaryReader (typeRep (Proxy :: Proxy a)) cb data BinaryReader s = BinaryReader - { getEntry :: BinHandle -> IO s + { getEntry :: ReadBinHandle -> IO s } deriving (Functor) data BinaryWriter s = BinaryWriter - { putEntry :: BinHandle -> s -> IO () + { putEntry :: WriteBinHandle -> s -> IO () } -mkWriter :: (BinHandle -> s -> IO ()) -> BinaryWriter s +mkWriter :: (WriteBinHandle -> s -> IO ()) -> BinaryWriter s mkWriter f = BinaryWriter { putEntry = f } -mkReader :: (BinHandle -> IO s) -> BinaryReader s +mkReader :: (ReadBinHandle -> IO s) -> BinaryReader s mkReader f = BinaryReader { getEntry = f } @@ -1212,7 +1250,7 @@ mkReader f = BinaryReader -- | Find the 'BinaryReader' for the 'Binary' instance for the type identified by 'Proxy a'. -- -- If no 'BinaryReader' has been configured before, this function will panic. -findUserDataReader :: forall a . (HasCallStack, Typeable a) => Proxy a -> BinHandle -> BinaryReader a +findUserDataReader :: forall a . (HasCallStack, Typeable a) => Proxy a -> ReadBinHandle -> BinaryReader a findUserDataReader query bh = case Map.lookup (typeRep query) (ud_reader_data $ getReaderUserData bh) of Nothing -> panic $ "Failed to find BinaryReader for the key: " ++ show (typeRep query) @@ -1222,7 +1260,7 @@ findUserDataReader query bh = -- | Find the 'BinaryWriter' for the 'Binary' instance for the type identified by 'Proxy a'. -- -- If no 'BinaryWriter' has been configured before, this function will panic. -findUserDataWriter :: forall a . (HasCallStack, Typeable a) => Proxy a -> BinHandle -> BinaryWriter a +findUserDataWriter :: forall a . (HasCallStack, Typeable a) => Proxy a -> WriteBinHandle -> BinaryWriter a findUserDataWriter query bh = case Map.lookup (typeRep query) (ud_writer_data $ getWriterUserData bh) of Nothing -> panic $ "Failed to find BinaryWriter for the key: " ++ show (typeRep query) @@ -1239,8 +1277,8 @@ noWriterUserData = WriterUserData { ud_writer_data = Map.empty } -newReadState :: (BinHandle -> IO Name) -- ^ how to deserialize 'Name's - -> (BinHandle -> IO FastString) +newReadState :: (ReadBinHandle -> IO Name) -- ^ how to deserialize 'Name's + -> (ReadBinHandle -> IO FastString) -> ReaderUserData newReadState get_name get_fs = mkReaderUserData @@ -1249,11 +1287,11 @@ newReadState get_name get_fs = , mkSomeBinaryReader $ mkReader get_fs ] -newWriteState :: (BinHandle -> Name -> IO ()) +newWriteState :: (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize non-binding 'Name's - -> (BinHandle -> Name -> IO ()) + -> (WriteBinHandle -> Name -> IO ()) -- ^ how to serialize binding 'Name's - -> (BinHandle -> FastString -> IO ()) + -> (WriteBinHandle -> FastString -> IO ()) -> WriterUserData newWriteState put_non_binding_name put_binding_name put_fs = mkWriterUserData @@ -1267,12 +1305,12 @@ newWriteState put_non_binding_name put_binding_name put_fs = -- ---------------------------------------------------------------------------- data ReaderTable a = ReaderTable - { getTable :: BinHandle -> IO (SymbolTable a) + { getTable :: ReadBinHandle -> IO (SymbolTable a) , mkReaderFromTable :: SymbolTable a -> BinaryReader a } data WriterTable = WriterTable - { putTable :: BinHandle -> IO Int + { putTable :: WriteBinHandle -> IO Int } --------------------------------------------------------- @@ -1312,14 +1350,14 @@ initFastStringWriterTable = do , mkWriter $ putDictFastString bin_dict ) -putDictionary :: BinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () +putDictionary :: WriteBinHandle -> Int -> UniqFM FastString (Int,FastString) -> IO () putDictionary bh sz dict = do put_ bh sz mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict))) -- It's OK to use nonDetEltsUFM here because the elements have indices -- that array uses to create order -getDictionary :: BinHandle -> IO Dictionary +getDictionary :: ReadBinHandle -> IO Dictionary getDictionary bh = do sz <- get bh :: IO Int mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int FastString) @@ -1328,12 +1366,12 @@ getDictionary bh = do writeArray mut_arr i fs unsafeFreeze mut_arr -getDictFastString :: Dictionary -> BinHandle -> IO FastString +getDictFastString :: Dictionary -> ReadBinHandle -> IO FastString getDictFastString dict bh = do j <- get bh return $! (dict ! fromIntegral (j :: Word32)) -putDictFastString :: FSTable -> BinHandle -> FastString -> IO () +putDictFastString :: FSTable -> WriteBinHandle -> FastString -> IO () putDictFastString dict bh fs = allocateFastString dict fs >>= put_ bh allocateFastString :: FSTable -> FastString -> IO Word32 @@ -1370,34 +1408,34 @@ type SymbolTable a = Array Int a -- Reading and writing FastStrings --------------------------------------------------------- -putFS :: BinHandle -> FastString -> IO () +putFS :: WriteBinHandle -> FastString -> IO () putFS bh fs = putBS bh $ bytesFS fs -getFS :: BinHandle -> IO FastString +getFS :: ReadBinHandle -> IO FastString getFS bh = do l <- get bh :: IO Int getPrim bh l (\src -> pure $! mkFastStringBytes src l ) -- | Put a ByteString without its length (can't be read back without knowing the -- length!) -putByteString :: BinHandle -> ByteString -> IO () +putByteString :: WriteBinHandle -> ByteString -> IO () putByteString bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -- | Get a ByteString whose length is known -getByteString :: BinHandle -> Int -> IO ByteString +getByteString :: ReadBinHandle -> Int -> IO ByteString getByteString bh l = BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) -putBS :: BinHandle -> ByteString -> IO () +putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> copyBytes op (castPtr ptr) l) -getBS :: BinHandle -> IO ByteString +getBS :: ReadBinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -35,7 +35,7 @@ instance Binary TyCon where get bh = mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh -getSomeTypeRep :: BinHandle -> IO SomeTypeRep +getSomeTypeRep :: ReadBinHandle -> IO SomeTypeRep getSomeTypeRep bh = do tag <- get bh :: IO Word8 case tag of @@ -167,7 +167,7 @@ instance Binary TypeLitSort where 2 -> pure TypeLitChar _ -> fail "Binary.putTypeLitSort: invalid tag" -putTypeRep :: BinHandle -> TypeRep a -> IO () +putTypeRep :: WriteBinHandle -> TypeRep a -> IO () putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit c641b7349239c497cbd64a64cd21fd388f431b9f +Subproject commit edf742131e272fc29c6d6eae549b0fe37eea11b9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/adf68fbabc8b0654e324959421496a59d85deb14 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/adf68fbabc8b0654e324959421496a59d85deb14 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 13:39:09 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Fri, 05 Apr 2024 09:39:09 -0400 Subject: [Git][ghc/ghc][wip/fendor/ifacetype-deduplication] Add deduplication table for `IfaceType` Message-ID: <660ffefde858e_180afb182a95048778@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ifacetype-deduplication at Glasgow Haskell Compiler / GHC Commits: 748bf100 by Matthew Pickering at 2024-04-05T15:38:40+02:00 Add deduplication table for `IfaceType` The type `IfaceType` is a highly redundant, tree-like data structure. While benchmarking, we realised that the high redundancy of `IfaceType` causes high memory consumption in GHCi sessions. We fix this by adding a deduplication table to the serialisation of `ModIface`, similar to how we deduplicate `Name`s and `FastString`s. This deduplication has the beneficial side effect to additionally reduce the size of the on-disk interface files tremendously. On the agda code base, we reduce the size from 28 MB to 16 MB. When `-fwrite-simplified-core` is enabled, we reduce the size from 112 MB to 22 MB. We have to add an `Ord` instance to `IfaceType` in order to store it effeiciently for look up operations. This is mostly straightforward, we change occurrences of `FastString` with `LexicalFastString` and add a newtype definition for `IfLclName = LexicalFastString`. Bump haddock submodule for `IfLclName` newtype changes. - - - - - 20 changed files: - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Utils/Binary.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/Language/Haskell/Syntax/Type.hs-boot - utils/haddock Changes: ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -952,13 +952,13 @@ data CoSel -- See Note [SelCo] | SelForAll -- Decomposes (forall a. co) - deriving( Eq, Data.Data ) + deriving( Eq, Data.Data, Ord ) data FunSel -- See Note [SelCo] = SelMult -- Multiplicity | SelArg -- Argument of function | SelRes -- Result of function - deriving( Eq, Data.Data ) + deriving( Eq, Data.Data, Ord ) type CoercionN = Coercion -- always nominal type CoercionR = Coercion -- always representational ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -121,7 +121,7 @@ toIfaceTvBndr :: TyVar -> IfaceTvBndr toIfaceTvBndr = toIfaceTvBndrX emptyVarSet toIfaceTvBndrX :: VarSet -> TyVar -> IfaceTvBndr -toIfaceTvBndrX fr tyvar = ( occNameFS (getOccName tyvar) +toIfaceTvBndrX fr tyvar = ( mkIfLclName (occNameFS (getOccName tyvar)) , toIfaceTypeX fr (tyVarKind tyvar) ) @@ -133,7 +133,7 @@ toIfaceIdBndr = toIfaceIdBndrX emptyVarSet toIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr toIfaceIdBndrX fr covar = ( toIfaceType (idMult covar) - , occNameFS (getOccName covar) + , mkIfLclName (occNameFS (getOccName covar)) , toIfaceTypeX fr (varType covar) ) @@ -218,11 +218,11 @@ toIfaceTypeX fr (TyConApp tc tys) arity = tyConArity tc n_tys = length tys -toIfaceTyVar :: TyVar -> FastString -toIfaceTyVar = occNameFS . getOccName +toIfaceTyVar :: TyVar -> IfLclName +toIfaceTyVar = mkIfLclName . occNameFS . getOccName -toIfaceCoVar :: CoVar -> FastString -toIfaceCoVar = occNameFS . getOccName +toIfaceCoVar :: CoVar -> IfLclName +toIfaceCoVar = mkIfLclName . occNameFS . getOccName ---------------- toIfaceTyCon :: TyCon -> IfaceTyCon @@ -264,7 +264,7 @@ toIfaceTyCon_name n = IfaceTyCon n info toIfaceTyLit :: TyLit -> IfaceTyLit toIfaceTyLit (NumTyLit x) = IfaceNumTyLit x -toIfaceTyLit (StrTyLit x) = IfaceStrTyLit x +toIfaceTyLit (StrTyLit x) = IfaceStrTyLit (LexicalFastString x) toIfaceTyLit (CharTyLit x) = IfaceCharTyLit x ---------------- @@ -296,7 +296,7 @@ toIfaceCoercionX fr co go (InstCo co arg) = IfaceInstCo (go co) (go arg) go (KindCo c) = IfaceKindCo (go c) go (SubCo co) = IfaceSubCo (go co) - go (AxiomRuleCo co cs) = IfaceAxiomRuleCo (coaxrName co) (map go cs) + go (AxiomRuleCo co cs) = IfaceAxiomRuleCo (mkIfLclName (coaxrName co)) (map go cs) go (AxiomInstCo c i cs) = IfaceAxiomInstCo (coAxiomName c) i (map go cs) go (UnivCo p r t1 t2) = IfaceUnivCo (go_prov p) r (toIfaceTypeX fr t1) @@ -433,7 +433,7 @@ toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang toIfaceSrcBang (HsSrcBang _ unpk bang) = IfSrcBang unpk bang toIfaceLetBndr :: Id -> IfaceLetBndr -toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id)) +toIfaceLetBndr id = IfLetBndr (mkIfLclName (occNameFS (getOccName id))) (toIfaceType (idType id)) (toIfaceIdInfo (idInfo id)) (idJoinPointHood id) @@ -444,7 +444,7 @@ toIfaceTopBndr :: Id -> IfaceTopBndrInfo toIfaceTopBndr id = if isExternalName name then IfGblTopBndr name - else IfLclTopBndr (occNameFS (getOccName id)) (toIfaceType (idType id)) + else IfLclTopBndr (mkIfLclName (occNameFS (getOccName id))) (toIfaceType (idType id)) (toIfaceIdInfo (idInfo id)) (toIfaceIdDetails (idDetails id)) where name = getName id @@ -555,7 +555,7 @@ toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfac toIfaceExpr (App f a) = toIfaceApp f [a] toIfaceExpr (Case s x ty as) | null as = IfaceECase (toIfaceExpr s) (toIfaceType ty) - | otherwise = IfaceCase (toIfaceExpr s) (getOccFS x) (map toIfaceAlt as) + | otherwise = IfaceCase (toIfaceExpr s) (mkIfLclName (getOccFS x)) (map toIfaceAlt as) toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e) toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceCoercion co) toIfaceExpr (Tick t e) = IfaceTick (toIfaceTickish t) (toIfaceExpr e) @@ -610,7 +610,7 @@ toIfaceTopBind b = --------------------- toIfaceAlt :: CoreAlt -> IfaceAlt -toIfaceAlt (Alt c bs r) = IfaceAlt (toIfaceCon c) (map getOccFS bs) (toIfaceExpr r) +toIfaceAlt (Alt c bs r) = IfaceAlt (toIfaceCon c) (map (mkIfLclName . getOccFS) bs) (toIfaceExpr r) --------------------- toIfaceCon :: AltCon -> IfaceConAlt @@ -655,7 +655,7 @@ toIfaceVar v -- Foreign calls have special syntax | isExternalName name = IfaceExt name - | otherwise = IfaceLcl (occNameFS $ nameOccName name) + | otherwise = IfaceLcl (mkIfLclName (occNameFS $ nameOccName name)) where name = idName v ty = idType v ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -283,13 +283,16 @@ instance Ord NonDetFastString where -- `lexicalCompareFS` (i.e. which compares FastStrings on their String -- representation). Hence it is deterministic from one run to the other. newtype LexicalFastString - = LexicalFastString FastString + = LexicalFastString { getLexicalFastString :: FastString } deriving newtype (Eq, Show) deriving stock Data instance Ord LexicalFastString where compare (LexicalFastString fs1) (LexicalFastString fs2) = lexicalCompareFS fs1 fs2 +instance NFData LexicalFastString where + rnf (LexicalFastString f) = rnf f + -- ----------------------------------------------------------------------------- -- Construction ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -54,6 +54,9 @@ import Data.Char import Data.Word import Data.IORef import Control.Monad +import GHC.Iface.Type (IfaceType, getIfaceType, putIfaceType) +import System.IO.Unsafe + -- --------------------------------------------------------------------------- -- Reading and writing binary interface files @@ -158,9 +161,13 @@ getWithUserData name_cache bh = do -- Reading names has the side effect of adding them into the given NameCache. getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do - fsReaderTable <- initFastStringReaderTable - nameReaderTable <- (initReadNameCachedBinary name_cache) + bhRef <- newIORef (error "used too soon") + -- It is important this is passed to 'getTable' + ud <- unsafeInterleaveIO (readIORef bhRef) + fsReaderTable <- initFastStringReaderTable + nameReaderTable <- initReadNameCachedBinary name_cache + ifaceTypeReaderTable <- initReadIfaceTypeTable ud -- The order of these deserialisation matters! -- @@ -168,14 +175,21 @@ getTables name_cache bh = do fsTable <- Binary.forwardGet bh (getTable fsReaderTable bh) let fsReader = mkReaderFromTable fsReaderTable fsTable - bhFs = addReaderToUserData (mkSomeBinaryReader fsReader) bh + bhFs = addReaderToUserData fsReader bh + nameTable <- Binary.forwardGet bh (getTable nameReaderTable bhFs) let nameReader = mkReaderFromTable nameReaderTable nameTable - bhName = addReaderToUserData (mkSomeBinaryReader nameReader) bhFs + bhName = addReaderToUserData nameReader bhFs - pure bhName + ifaceTypeTable <- Binary.forwardGet bh (getTable ifaceTypeReaderTable bhName) + let + ifaceTypeReader = mkReaderFromTable ifaceTypeReaderTable ifaceTypeTable + bhIfaceType = addReaderToUserData ifaceTypeReader bhName + + writeIORef bhRef (getReaderUserData bhIfaceType) + pure bhIfaceType -- | Write an interface file. -- @@ -238,11 +252,13 @@ putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) putWithTables bh' put_payload = do (fast_wt, fsWriter) <- initFastStringWriterTable (name_wt, nameWriter) <- initWriteNameTable + (ifaceType_wt, ifaceTypeWriter) <- initWriteIfaceType let writerUserData = mkWriterUserData [ mkSomeBinaryWriter @FastString fsWriter , mkSomeBinaryWriter @Name nameWriter , mkSomeBinaryWriter @BindingName $ mkWriter (\bh name -> putEntry nameWriter bh (getBindingName name)) + , mkSomeBinaryWriter @IfaceType ifaceTypeWriter ] let bh = setWriterUserData bh' writerUserData @@ -250,7 +266,7 @@ putWithTables bh' put_payload = do -- The order of these entries matters! -- -- See Note [Iface Binary Serialiser Order] for details. - putAllTables bh [fast_wt, name_wt] $ do + putAllTables bh [fast_wt, name_wt, ifaceType_wt] $ do put_payload bh return (name_count, fs_count, r) @@ -335,6 +351,24 @@ Here, a visualisation of the table structure we currently have: -- The symbol table -- +initReadIfaceTypeTable :: ReaderUserData -> IO (ReaderTable IfaceType) +initReadIfaceTypeTable ud = do + pure $ + ReaderTable + { getTable = getGenericSymbolTable (\bh -> getIfaceType (setReaderUserData bh ud)) + , mkReaderFromTable = \tbl -> mkReader (getGenericSymtab tbl) + } + +initWriteIfaceType :: IO (WriterTable, BinaryWriter IfaceType) +initWriteIfaceType = do + sym_tab <- initGenericSymbolTable + pure + ( WriterTable + { putTable = putGenericSymbolTable sym_tab (lazyPut' putIfaceType) + } + , mkWriter $ putGenericSymTab sym_tab + ) + initReadNameCachedBinary :: NameCache -> IO (ReaderTable Name) initReadNameCachedBinary cache = do ===================================== compiler/GHC/Iface/Decl.hs ===================================== @@ -45,7 +45,6 @@ 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 @@ -147,7 +146,7 @@ tyConToIfaceDecl env tycon | Just fam_flav <- famTyConFlav_maybe tycon = ( tc_env1 , IfaceFamily { ifName = getName tycon, - ifResVar = if_res_var, + ifResVar = mkIfLclName <$> if_res_var, ifFamFlav = to_if_fam_flav fam_flav, ifBinders = if_binders, ifResKind = if_res_kind, @@ -288,7 +287,7 @@ classToIfaceDecl env clas ifClassCtxt = tidyToIfaceContext env1 sc_theta, ifATs = map toIfaceAT clas_ats, ifSigs = map toIfaceClassOp op_stuff, - ifMinDef = toIfaceBooleanFormula $ fmap getOccFS (classMinimalDef clas) + ifMinDef = toIfaceBooleanFormula $ fmap (mkIfLclName . getOccFS) (classMinimalDef clas) } (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon) @@ -334,7 +333,7 @@ tidyTyConBinder env@(_, subst) tvb@(Bndr tv vis) tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder]) tidyTyConBinders = mapAccumL tidyTyConBinder -tidyTyVar :: TidyEnv -> TyVar -> FastString +tidyTyVar :: TidyEnv -> TyVar -> IfLclName tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv) toIfaceBooleanFormula :: BooleanFormula IfLclName -> IfaceBooleanFormula ===================================== compiler/GHC/Iface/Env.hs ===================================== @@ -34,7 +34,6 @@ import GHC.Runtime.Context import GHC.Unit.Module import GHC.Unit.Module.ModIface -import GHC.Data.FastString import GHC.Data.FastString.Env import GHC.Types.Var @@ -190,10 +189,10 @@ setNameModule (Just m) n = ************************************************************************ -} -tcIfaceLclId :: FastString -> IfL Id +tcIfaceLclId :: IfLclName -> IfL Id tcIfaceLclId occ = do { lcl <- getLclEnv - ; case lookupFsEnv (if_id_env lcl) occ of + ; case lookupFsEnv (if_id_env lcl) (ifLclNameFS occ) of Just ty_var -> return ty_var Nothing -> failIfM $ vcat @@ -209,10 +208,10 @@ extendIfaceIdEnv ids in env { if_id_env = id_env' } -tcIfaceTyVar :: FastString -> IfL TyVar +tcIfaceTyVar :: IfLclName -> IfL TyVar tcIfaceTyVar occ = do { lcl <- getLclEnv - ; case lookupFsEnv (if_tv_env lcl) occ of + ; case lookupFsEnv (if_tv_env lcl) (ifLclNameFS occ) of Just ty_var -> return ty_var Nothing -> failIfM (text "Iface type variable out of scope: " <+> ppr occ) } @@ -220,15 +219,15 @@ tcIfaceTyVar occ lookupIfaceTyVar :: IfaceTvBndr -> IfL (Maybe TyVar) lookupIfaceTyVar (occ, _) = do { lcl <- getLclEnv - ; return (lookupFsEnv (if_tv_env lcl) occ) } + ; return (lookupFsEnv (if_tv_env lcl) (ifLclNameFS occ)) } lookupIfaceVar :: IfaceBndr -> IfL (Maybe TyCoVar) lookupIfaceVar (IfaceIdBndr (_, occ, _)) = do { lcl <- getLclEnv - ; return (lookupFsEnv (if_id_env lcl) occ) } + ; return (lookupFsEnv (if_id_env lcl) (ifLclNameFS occ)) } lookupIfaceVar (IfaceTvBndr (occ, _)) = do { lcl <- getLclEnv - ; return (lookupFsEnv (if_tv_env lcl) occ) } + ; return (lookupFsEnv (if_tv_env lcl) (ifLclNameFS occ)) } extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a extendIfaceTyVarEnv tyvars ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Types.Unique.FM import qualified Data.Array as A import qualified Data.Array.IO as A import qualified Data.Array.Unsafe as A +import Data.Function ( (&) ) import Data.IORef import Data.ByteString ( ByteString ) import qualified Data.ByteString as BS @@ -43,6 +44,7 @@ import System.Directory ( createDirectoryIfMissing ) import System.FilePath ( takeDirectory ) import GHC.Iface.Ext.Types +import GHC.Iface.Syntax (getIfaceType, putIfaceType ) data HieSymbolTable = HieSymbolTable { hie_symtab_next :: !FastMutInt @@ -105,10 +107,13 @@ writeHieFile hie_file_path hiefile = do hie_dict_map = dict_map_ref } -- put the main thing - let bh = setWriterUserData bh0 - $ newWriteState (putName hie_symtab) - (putName hie_symtab) - (putFastString hie_dict) + let bh = setWriterUserData bh0 $ mkWriterUserData + [ mkSomeBinaryWriter (mkWriter putIfaceType) + , mkSomeBinaryWriter (mkWriter $ putName hie_symtab) + , mkSomeBinaryWriter (simpleBindingNameWriter $ mkWriter $ putName hie_symtab) + , mkSomeBinaryWriter (mkWriter $ putFastString hie_dict) + ] + put_ bh hiefile -- write the symtab pointer at the front of the file @@ -219,13 +224,13 @@ readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data bh1 <- do - let bh1 = setReaderUserData bh0 - $ newReadState (error "getSymtabName") - (getDictFastString dict) + let bh1 = addReaderToUserData (mkReader $ getDictFastString dict) bh0 symtab <- get_symbol_table bh1 - let bh1' = setReaderUserData bh1 - $ newReadState (getSymTabName symtab) - (getDictFastString dict) + let bh1' = bh1 + & addReaderToUserData (mkReader getIfaceType) + & addReaderToUserData (mkReader $ getSymTabName symtab) + & addReaderToUserData (simpleBindingNameReader $ mkReader $ getSymTabName symtab) + & addReaderToUserData (mkReader getIfaceType) return bh1' -- load the actual data ===================================== compiler/GHC/Iface/Ext/Utils.hs ===================================== @@ -162,15 +162,15 @@ getEvidenceTree refmap var = go emptyNameSet var hieTypeToIface :: HieTypeFix -> IfaceType hieTypeToIface = foldType go where - go (HTyVarTy n) = IfaceTyVar $ occNameFS $ getOccName n + go (HTyVarTy n) = IfaceTyVar $ (mkIfLclName (occNameFS $ getOccName n)) go (HAppTy a b) = IfaceAppTy a (hieToIfaceArgs b) go (HLitTy l) = IfaceLitTy l - go (HForAllTy ((n,k),af) t) = let b = (occNameFS $ getOccName n, k) + go (HForAllTy ((n,k),af) t) = let b = (mkIfLclName (occNameFS $ getOccName n), k) in IfaceForAllTy (Bndr (IfaceTvBndr b) af) t go (HFunTy w a b) = IfaceFunTy visArgTypeLike w a b go (HQualTy pred b) = IfaceFunTy invisArgTypeLike many_ty pred b go (HCastTy a) = a - go HCoercionTy = IfaceTyVar "" + go HCoercionTy = IfaceTyVar (mkIfLclName "") go (HTyConApp a xs) = IfaceTyConApp a (hieToIfaceArgs xs) -- This isn't fully faithful - we can't produce the 'Inferred' case ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -1216,8 +1216,8 @@ addFingerprints hsc_env iface0 getOcc (IfLclTopBndr fs _ _ details) = case details of IfRecSelId { ifRecSelFirstCon = first_con } - -> mkRecFieldOccFS (getOccFS first_con) fs - _ -> mkVarOccFS fs + -> mkRecFieldOccFS (getOccFS first_con) (ifLclNameFS fs) + _ -> mkVarOccFS (ifLclNameFS fs) binding_key (IfaceNonRec b _) = IfaceNonRec (getOcc b) () binding_key (IfaceRec bs) = IfaceRec (map (\(b, _) -> (getOcc b, ())) bs) ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Utils.Fingerprint import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain +import GHC.Iface.Type (putIfaceType) fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f @@ -34,8 +35,12 @@ computeFingerprint put_nonbinding_name a = do put_ bh a fingerprintBinMem bh where - set_user_data bh = - setWriterUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS + set_user_data bh = setWriterUserData bh $ mkWriterUserData + [ mkSomeBinaryWriter $ mkWriter putIfaceType + , mkSomeBinaryWriter $ mkWriter put_nonbinding_name + , mkSomeBinaryWriter $ simpleBindingNameWriter $ mkWriter putNameLiterally + , mkSomeBinaryWriter $ mkWriter putFS + ] -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -632,6 +632,7 @@ data IfaceExpr | IfaceFCall ForeignCall IfaceType | IfaceTick IfaceTickish IfaceExpr -- from Tick tickish E + data IfaceTickish = IfaceHpcTick Module Int -- from HpcTick x | IfaceSCC CostCentre Bool Bool -- from ProfNote @@ -1026,7 +1027,7 @@ pprIfaceDecl ss (IfaceClass { ifName = clas pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions text "{-# MINIMAL" <+> pprBooleanFormula - (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+> + (\_ def -> cparen (isLexSym def) (ppr def)) 0 (fmap ifLclNameFS minDef) <+> text "#-}" -- See Note [Suppressing binder signatures] in GHC.Iface.Type ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -10,7 +10,8 @@ This module defines interface types and binders {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE LambdaCase #-} module GHC.Iface.Type ( - IfExtName, IfLclName, + IfExtName, + IfLclName(..), mkIfLclName, ifLclNameFS, IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..), IfaceMCoercion(..), @@ -32,6 +33,8 @@ module GHC.Iface.Type ( ifForAllBndrVar, ifForAllBndrName, ifaceBndrName, ifTyConBinderVar, ifTyConBinderName, + -- Binary utilities + putIfaceType, getIfaceType, -- Equality testing isIfaceLiftedTypeKind, @@ -90,9 +93,11 @@ import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) import Control.DeepSeq +import Data.Proxy import Control.Monad ((<$!>)) +import Control.Arrow (first) import qualified Data.Semigroup as Semi -import Data.Maybe( isJust ) +import Data.Maybe (isJust) {- ************************************************************************ @@ -102,7 +107,16 @@ import Data.Maybe( isJust ) ************************************************************************ -} -type IfLclName = FastString -- A local name in iface syntax +-- | A local name in iface syntax +newtype IfLclName = IfLclName + { getIfLclName :: LexicalFastString + } deriving (Eq, Ord, Show) + +ifLclNameFS :: IfLclName -> FastString +ifLclNameFS = getLexicalFastString . getIfLclName + +mkIfLclName :: FastString -> IfLclName +mkIfLclName = IfLclName . LexicalFastString type IfExtName = Name -- An External or WiredIn Name can appear in Iface syntax -- (However Internal or System Names never should) @@ -110,6 +124,8 @@ type IfExtName = Name -- An External or WiredIn Name can appear in Iface synta data IfaceBndr -- Local (non-top-level) binders = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr + deriving (Eq, Ord) + type IfaceIdBndr = (IfaceType, IfLclName, IfaceType) type IfaceTvBndr = (IfLclName, IfaceKind) @@ -178,6 +194,7 @@ data IfaceType -- In an experiment, removing IfaceTupleTy resulted in a 0.75% regression -- in interface file size (in GHC's boot libraries). -- See !3987. + deriving (Eq, Ord) type IfaceMult = IfaceType @@ -186,9 +203,9 @@ type IfaceContext = [IfacePredType] data IfaceTyLit = IfaceNumTyLit Integer - | IfaceStrTyLit FastString + | IfaceStrTyLit LexicalFastString | IfaceCharTyLit Char - deriving (Eq) + deriving (Eq, Ord) type IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis type IfaceForAllBndr = VarBndr IfaceBndr ForAllTyFlag @@ -230,6 +247,7 @@ data IfaceAppArgs -- arguments in @{...}. IfaceAppArgs -- The rest of the arguments + deriving (Eq, Ord) instance Semi.Semigroup IfaceAppArgs where IA_Nil <> xs = xs @@ -256,7 +274,7 @@ data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName -- See Note [Sharing IfaceTyConInfo] for why -- sharing is so important for 'IfaceTyConInfo'. } - deriving (Eq) + deriving (Eq, Ord) -- | The various types of TyCons which have special, built-in syntax. data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon @@ -276,7 +294,7 @@ data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon -- that is actually being applied to two types -- of the same kind. This affects pretty-printing -- only: see Note [Equality predicates in IfaceType] - deriving (Eq) + deriving (Eq, Ord) instance Outputable IfaceTyConSort where ppr IfaceNormalTyCon = text "normal" @@ -370,7 +388,7 @@ data IfaceTyConInfo -- Used only to guide pretty-printing -- should be printed as 'D to distinguish it from -- an existing type constructor D. , ifaceTyConSort :: IfaceTyConSort } - deriving (Eq) + deriving (Eq, Ord) -- | This smart constructor allows sharing of the two most common -- cases. See Note [Sharing IfaceTyConInfo] @@ -420,7 +438,7 @@ This one change leads to an 15% reduction in residency for GHC when embedding data IfaceMCoercion = IfaceMRefl - | IfaceMCo IfaceCoercion + | IfaceMCo IfaceCoercion deriving (Eq, Ord) data IfaceCoercion = IfaceReflCo IfaceType @@ -445,11 +463,13 @@ data IfaceCoercion | IfaceSubCo IfaceCoercion | IfaceFreeCoVar CoVar -- See Note [Free tyvars in IfaceType] | IfaceHoleCo CoVar -- ^ See Note [Holes in IfaceCoercion] + deriving (Eq, Ord) data IfaceUnivCoProv = IfacePhantomProv IfaceCoercion | IfaceProofIrrelProv IfaceCoercion | IfacePluginProv String + deriving (Eq, Ord) {- Note [Holes in IfaceCoercion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -621,11 +641,11 @@ type IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType] mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst -- See Note [Substitution on IfaceType] -mkIfaceTySubst eq_spec = mkFsEnv eq_spec +mkIfaceTySubst eq_spec = mkFsEnv (map (first ifLclNameFS) eq_spec) inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool -- See Note [Substitution on IfaceType] -inDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst fs) +inDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst (ifLclNameFS fs)) substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType -- See Note [Substitution on IfaceType] @@ -681,7 +701,7 @@ substIfaceAppArgs env args substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType substIfaceTyVar env tv - | Just ty <- lookupFsEnv env tv = ty + | Just ty <- lookupFsEnv env (ifLclNameFS tv) = ty | otherwise = IfaceTyVar tv @@ -1190,7 +1210,7 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 , Just substituted_ty <- check_substitution var_kind - = let subs' = extendFsEnv subs var substituted_ty + = let subs' = extendFsEnv subs (ifLclNameFS var) substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall in go subs' True ty @@ -1198,7 +1218,7 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty go subs rank1 (IfaceForAllTy bndr ty) = IfaceForAllTy (go_ifacebndr subs bndr) (go subs rank1 ty) - go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs (ifLclNameFS tv) of Just s -> s Nothing -> ty @@ -1626,7 +1646,7 @@ pprTyTcApp ctxt_prec tc tys = , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) Required (IA_Arg ty Required IA_Nil) <- tys -> maybeParen ctxt_prec funPrec - $ char '?' <> ftext n <> text "::" <> ppr_ty topPrec ty + $ char '?' <> ftext (getLexicalFastString n) <> text "::" <> ppr_ty topPrec ty | IfaceTupleTyCon arity sort <- ifaceTyConSort info , not debug @@ -2014,6 +2034,9 @@ pprIfaceUnivCoProv (IfacePluginProv s) = text "plugin" <+> doubleQuotes (text s) ------------------- +instance Outputable IfLclName where + ppr = ppr . ifLclNameFS + instance Outputable IfaceTyCon where ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc) @@ -2171,38 +2194,47 @@ ppr_parend_preds :: [IfacePredType] -> SDoc ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds))) instance Binary IfaceType where - put_ _ (IfaceFreeTyVar tv) - = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv) - - put_ bh (IfaceForAllTy aa ab) = do - putByte bh 0 - put_ bh aa - put_ bh ab - put_ bh (IfaceTyVar ad) = do - putByte bh 1 - put_ bh ad - put_ bh (IfaceAppTy ae af) = do - putByte bh 2 - put_ bh ae - put_ bh af - put_ bh (IfaceFunTy af aw ag ah) = do - putByte bh 3 - put_ bh af - put_ bh aw - put_ bh ag - put_ bh ah - put_ bh (IfaceTyConApp tc tys) - = do { putByte bh 5; put_ bh tc; put_ bh tys } - put_ bh (IfaceCastTy a b) - = do { putByte bh 6; put_ bh a; put_ bh b } - put_ bh (IfaceCoercionTy a) - = do { putByte bh 7; put_ bh a } - put_ bh (IfaceTupleTy s i tys) - = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys } - put_ bh (IfaceLitTy n) - = do { putByte bh 9; put_ bh n } - - get bh = do + put_ bh tyCon = case findUserDataWriter Proxy bh of + tbl -> putEntry tbl bh tyCon + + get bh = case findUserDataReader Proxy bh of + tbl -> getEntry tbl bh + + +putIfaceType :: WriteBinHandle -> IfaceType -> IO () +putIfaceType _ (IfaceFreeTyVar tv) + = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv) + +putIfaceType bh (IfaceForAllTy aa ab) = do + putByte bh 0 + put_ bh aa + put_ bh ab +putIfaceType bh (IfaceTyVar ad) = do + putByte bh 1 + put_ bh ad +putIfaceType bh (IfaceAppTy ae af) = do + putByte bh 2 + put_ bh ae + put_ bh af +putIfaceType bh (IfaceFunTy af aw ag ah) = do + putByte bh 3 + put_ bh af + put_ bh aw + put_ bh ag + put_ bh ah +putIfaceType bh (IfaceTyConApp tc tys) + = do { putByte bh 5; put_ bh tc; put_ bh tys } +putIfaceType bh (IfaceCastTy a b) + = do { putByte bh 6; put_ bh a; put_ bh b } +putIfaceType bh (IfaceCoercionTy a) + = do { putByte bh 7; put_ bh a } +putIfaceType bh (IfaceTupleTy s i tys) + = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys } +putIfaceType bh (IfaceLitTy n) + = do { putByte bh 9; put_ bh n } + +getIfaceType :: HasCallStack => ReadBinHandle -> IO IfaceType +getIfaceType bh = do h <- getByte bh case h of 0 -> do aa <- get bh @@ -2230,6 +2262,13 @@ instance Binary IfaceType where _ -> do n <- get bh return (IfaceLitTy n) +instance Binary IfLclName where + put_ bh = put_ bh . ifLclNameFS + + get bh = do + fs <- get bh + pure $ IfLclName $ LexicalFastString fs + instance Binary IfaceMCoercion where put_ bh IfaceMRefl = putByte bh 1 @@ -2475,6 +2514,9 @@ instance NFData IfaceTyConSort where IfaceSumTyCon arity -> rnf arity IfaceEqualityTyCon -> () +instance NFData IfLclName where + rnf (IfLclName lfs) = rnf lfs + instance NFData IfaceTyConInfo where rnf (IfaceTyConInfo f s) = f `seq` rnf s ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -733,7 +733,7 @@ tc_iface_decl parent _ (IfaceFamily {ifName = tc_name, { res_kind' <- tcIfaceType res_kind -- Note [Synonym kind loop] ; rhs <- forkM (mk_doc tc_name) $ tc_fam_flav tc_name fam_flav - ; res_name <- traverse (newIfaceName . mkTyVarOccFS) res + ; res_name <- traverse (newIfaceName . mkTyVarOccFS . ifLclNameFS) res ; let tycon = mkFamilyTyCon tc_name binders' res_kind' res_name rhs parent inj ; return (ATyCon tycon) } where @@ -782,7 +782,7 @@ tc_iface_decl _parent ignore_prags ; 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 + ; mindef <- traverse (lookupIfaceTop . mkVarOccFS . ifLclNameFS) mindef_occ ; cls <- fixM $ \ cls -> do { ats <- mapM (tc_at cls) rdr_ats ; traceIf (text "tc-iface-class4" <+> ppr tc_name) @@ -936,8 +936,8 @@ mk_top_id (IfLclTopBndr raw_name iface_type info details) = do ; let occ = case details' of RecSelId { sel_tycon = parent } -> let con_fs = getOccFS $ recSelFirstConName parent - in mkRecFieldOccFS con_fs raw_name - _ -> mkVarOccFS raw_name + in mkRecFieldOccFS con_fs (ifLclNameFS raw_name) + _ -> mkVarOccFS (ifLclNameFS raw_name) ; name <- newIfaceName occ } info' <- tcIdInfo False TopLevel name ty info let new_id = mkGlobalId details' name ty info' @@ -1441,7 +1441,7 @@ tcIfaceCtxt sts = mapM tcIfaceType sts ----------------------------------------- tcIfaceTyLit :: IfaceTyLit -> IfL TyLit tcIfaceTyLit (IfaceNumTyLit n) = return (NumTyLit n) -tcIfaceTyLit (IfaceStrTyLit n) = return (StrTyLit n) +tcIfaceTyLit (IfaceStrTyLit n) = return (StrTyLit (getLexicalFastString n)) tcIfaceTyLit (IfaceCharTyLit n) = return (CharTyLit n) {- @@ -1485,7 +1485,7 @@ tcIfaceCo = go go (IfaceFreeCoVar c) = pprPanic "tcIfaceCo:IfaceFreeCoVar" (ppr c) go (IfaceHoleCo c) = pprPanic "tcIfaceCo:IfaceHoleCo" (ppr c) - go_var :: FastString -> IfL CoVar + go_var :: IfLclName -> IfL CoVar go_var = tcIfaceLclId tcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance @@ -1561,7 +1561,7 @@ tcIfaceExpr (IfaceECase scrut ty) tcIfaceExpr (IfaceCase scrut case_bndr alts) = do scrut' <- tcIfaceExpr scrut - case_bndr_name <- newIfaceName (mkVarOccFS case_bndr) + case_bndr_name <- newIfaceName (mkVarOccFS (ifLclNameFS case_bndr)) let scrut_ty = exprType scrut' case_mult = ManyTy @@ -1580,7 +1580,7 @@ tcIfaceExpr (IfaceCase scrut case_bndr alts) = do return (Case scrut' case_bndr' (coreAltsType alts') alts') tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) - = do { name <- newIfaceName (mkVarOccFS fs) + = do { name <- newIfaceName (mkVarOccFS (ifLclNameFS fs)) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel name ty' info @@ -1598,7 +1598,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) ; return (Let (Rec pairs') body') } } where tc_rec_bndr (IfLetBndr fs ty _ ji) - = do { name <- newIfaceName (mkVarOccFS fs) + = do { name <- newIfaceName (mkVarOccFS (ifLclNameFS fs)) ; ty' <- tcIfaceType ty ; return (mkLocalId name ManyTy ty' `asJoinId_maybe` ji) } tc_pair (IfLetBndr _ _ info _, rhs) id @@ -1655,12 +1655,12 @@ tcIfaceAlt scrut mult (tycon, inst_tys) (IfaceAlt (IfaceDataAlt data_occ) arg_st (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon))) ; tcIfaceDataAlt mult con inst_tys arg_strs rhs } -tcIfaceDataAlt :: Mult -> DataCon -> [Type] -> [FastString] -> IfaceExpr +tcIfaceDataAlt :: Mult -> DataCon -> [Type] -> [IfLclName] -> IfaceExpr -> IfL CoreAlt tcIfaceDataAlt mult con inst_tys arg_strs rhs = do { uniqs <- getUniquesM ; let (ex_tvs, arg_ids) - = dataConRepFSInstPat arg_strs uniqs mult con inst_tys + = dataConRepFSInstPat (map ifLclNameFS arg_strs) uniqs mult con inst_tys ; rhs' <- extendIfaceEnvs ex_tvs $ extendIfaceIdEnv arg_ids $ @@ -2031,7 +2031,7 @@ tcIfaceCoAxiomRule :: IfLclName -> IfL CoAxiomRule -- - axioms for type-level literals (Nat and Symbol), -- enumerated in typeNatCoAxiomRules tcIfaceCoAxiomRule n - | Just ax <- lookupUFM typeNatCoAxiomRules n + | Just ax <- lookupUFM typeNatCoAxiomRules (ifLclNameFS n) = return ax | otherwise = pprPanic "tcIfaceCoAxiomRule" (ppr n) @@ -2075,7 +2075,7 @@ tcIfaceImplicit n = do bindIfaceId :: IfaceIdBndr -> (Id -> IfL a) -> IfL a bindIfaceId (w, fs, ty) thing_inside - = do { name <- newIfaceName (mkVarOccFS fs) + = do { name <- newIfaceName (mkVarOccFS (ifLclNameFS fs)) ; ty' <- tcIfaceType ty ; w' <- tcIfaceType w ; let id = mkLocalIdOrCoVar name w' ty' @@ -2118,7 +2118,7 @@ bindIfaceForAllBndr (Bndr (IfaceIdBndr tv) vis) thing_inside bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a bindIfaceTyVar (occ,kind) thing_inside - = do { name <- newIfaceName (mkTyVarOccFS occ) + = do { name <- newIfaceName (mkTyVarOccFS (ifLclNameFS occ)) ; tyvar <- mk_iface_tyvar name kind ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) } ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -314,7 +314,7 @@ putObject bh mod_name deps os = do put_ bh (moduleNameString mod_name) (fs_tbl, fs_writer) <- initFastStringWriterTable - let bh_fs = addWriterToUserData (mkSomeBinaryWriter fs_writer) bh + let bh_fs = addWriterToUserData fs_writer bh forwardPut_ bh (const (putTable fs_tbl bh_fs)) $ do put_ bh_fs deps ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -148,7 +148,7 @@ import qualified Data.Semigroup as Semi ********************************************************************* -} data LeftOrRight = CLeft | CRight - deriving( Eq, Data ) + deriving( Eq, Data, Ord ) pickLR :: LeftOrRight -> (a,a) -> a pickLR CLeft (l,_) = l ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -720,7 +720,7 @@ Currently there are nine different uses of 'VarBndr': data VarBndr var argf = Bndr var argf -- See Note [The VarBndr type and its uses] - deriving( Data ) + deriving( Data, Eq, Ord) -- | Variable Binder -- ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -65,6 +65,8 @@ module GHC.Utils.Binary -- * Lazy Binary I/O lazyGet, lazyPut, + lazyGet', + lazyPut', lazyGetMaybe, lazyPutMaybe, @@ -87,10 +89,17 @@ module GHC.Utils.Binary initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, + -- * Generic deduplication table + GenericSymbolTable(..), + initGenericSymbolTable, + getGenericSymtab, putGenericSymTab, + getGenericSymbolTable, putGenericSymbolTable, -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..), -- * Newtypes for types that have canonically more than one valid encoding BindingName(..), + simpleBindingNameWriter, + simpleBindingNameReader, ) where import GHC.Prelude @@ -103,11 +112,11 @@ import GHC.Utils.Panic.Plain import GHC.Types.Unique.FM import GHC.Data.FastMutInt import GHC.Utils.Fingerprint -import GHC.Utils.Misc (HasCallStack) import GHC.Types.SrcLoc import GHC.Types.Unique import qualified GHC.Data.Strict as Strict import GHC.Utils.Outputable( JoinPointHood(..) ) +import GHC.Utils.Misc ( HasCallStack ) import Control.DeepSeq import Control.Monad ( when, (<$!>), unless, forM_, void ) @@ -127,7 +136,7 @@ import qualified Data.Map.Strict as Map import Data.Set ( Set ) import qualified Data.Set as Set import Data.Time -import Data.List (unfoldr) +import Data.List (sortOn, unfoldr) import Data.Typeable import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) @@ -230,22 +239,26 @@ setReaderUserData bh us = bh { rbm_userData = us } -- | Add 'SomeBinaryReader' as a known binary decoder. -- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', -- it is overwritten. -addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle -addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh +addReaderToUserData :: Typeable a => BinaryReader a -> ReadBinHandle -> ReadBinHandle +addReaderToUserData reader bh = bh { rbm_userData = (rbm_userData bh) { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) } } + where + cache@(SomeBinaryReader typRep _) = mkSomeBinaryReader reader -- | Add 'SomeBinaryWriter' as a known binary encoder. -- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', -- it is overwritten. -addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle -addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh +addWriterToUserData :: Typeable a => BinaryWriter a -> WriteBinHandle -> WriteBinHandle +addWriterToUserData writer bh = bh { wbm_userData = (wbm_userData bh) { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) } } + where + cache@(SomeBinaryWriter typRep _) = mkSomeBinaryWriter writer -- | Get access to the underlying buffer. withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a @@ -1099,24 +1112,35 @@ forwardGet bh get_A = do -- Lazy reading/writing lazyPut :: Binary a => WriteBinHandle -> a -> IO () -lazyPut bh a = do +lazyPut = lazyPut' put_ + +lazyGet :: Binary a => ReadBinHandle -> IO a +lazyGet = lazyGet' Nothing (\_ -> get) + +lazyPut' :: HasCallStack => (WriteBinHandle -> a -> IO ()) -> WriteBinHandle -> a -> IO () +lazyPut' f bh a = do -- output the obj with a ptr to skip over it: pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr - put_ bh a -- dump the object + f bh a -- dump the object q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => ReadBinHandle -> IO a -lazyGet bh = do +lazyGet' :: HasCallStack => Maybe (IORef ReadBinHandle) -> (Bin () -> ReadBinHandle -> IO a) -> ReadBinHandle -> IO a +lazyGet' mbh f bh = do p <- get bh -- a BinPtr p_a <- tellBinReader bh + -- Do this before to avoid retaining reference to old BH inside the unsafeInterleaveIO. + let !get_inner_bh = maybe (pure bh) readIORef mbh a <- unsafeInterleaveIO $ do - -- NB: Use a fresh off_r variable in the child thread, for thread + -- NB: Use a fresh rbm_off_r variable in the child thread, for thread -- safety. + inner_bh <- get_inner_bh off_r <- newFastMutInt 0 - getAt bh { rbm_off_r = off_r } p_a + let bh' = inner_bh { rbm_off_r = off_r } + seekBinNoExpandReader bh' p_a + f p bh' seekBinNoExpandReader bh p -- skip over the object for now return a @@ -1170,6 +1194,12 @@ lazyGetMaybe bh = do newtype BindingName = BindingName { getBindingName :: Name } deriving ( Eq ) +simpleBindingNameWriter :: BinaryWriter Name -> BinaryWriter BindingName +simpleBindingNameWriter = coerce + +simpleBindingNameReader :: BinaryReader Name -> BinaryReader BindingName +simpleBindingNameReader = coerce + -- | Existential for 'BinaryWriter' with a type witness. data SomeBinaryWriter = forall a . SomeBinaryWriter TypeRep (BinaryWriter a) @@ -1310,6 +1340,80 @@ data WriterTable = WriterTable { putTable :: WriteBinHandle -> IO Int } +-- ---------------------------------------------------------------------------- +-- Common data structures for constructing and maintaining lookup tables for +-- binary serialisation and deserialisation. +-- ---------------------------------------------------------------------------- + +data GenericSymbolTable a = GenericSymbolTable + { gen_symtab_next :: !FastMutInt + -- ^ The next index to use + , gen_symtab_map :: !(IORef (Map.Map a Int)) + -- ^ Given a symbol, find the symbol + } + +initGenericSymbolTable :: IO (GenericSymbolTable a) +initGenericSymbolTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef Map.empty + pure $ GenericSymbolTable + { gen_symtab_next = symtab_next + , gen_symtab_map = symtab_map + } + +putGenericSymbolTable :: forall a. GenericSymbolTable a -> (WriteBinHandle -> a -> IO ()) -> WriteBinHandle -> IO Int +putGenericSymbolTable gen_sym_tab serialiser bh = do + putGenericSymbolTable bh + where + symtab_map = gen_symtab_map gen_sym_tab + symtab_next = gen_symtab_next gen_sym_tab + putGenericSymbolTable :: HasCallStack => WriteBinHandle -> IO Int + putGenericSymbolTable bh = do + let loop bound = do + d <- readIORef symtab_map + table_count <- readFastMutInt symtab_next + let vs = sortOn fst [(b, a) | (a,b) <- Map.toList d, b >= bound] + case vs of + [] -> return table_count + todo -> do + mapM_ (\n -> serialiser bh n) (map snd todo) + loop table_count + snd <$> + (forwardPut bh (const $ readFastMutInt symtab_next >>= put_ bh) $ + loop 0) + +getGenericSymbolTable :: forall a. (ReadBinHandle -> IO a) -> ReadBinHandle -> IO (SymbolTable a) +getGenericSymbolTable deserialiser bh = do + sz <- forwardGet bh (get bh) :: IO Int + mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int a) + -- Using lazyPut/lazyGet is quite space inefficient as each usage will allocate a large closure + -- (6 arguments-ish). + forM_ [0..(sz-1)] $ \i -> do + f <- lazyGet' Nothing (\_ -> deserialiser) bh + -- f <- deserialiser bh + writeArray mut_arr i f + unsafeFreeze mut_arr + +putGenericSymTab :: (Ord a, Binary a) => GenericSymbolTable a -> WriteBinHandle -> a -> IO () +putGenericSymTab GenericSymbolTable{ + gen_symtab_map = symtab_map_ref, + gen_symtab_next = symtab_next } + bh val = do + symtab_map <- readIORef symtab_map_ref + case Map.lookup val symtab_map of + Just off -> put_ bh (fromIntegral off :: Word32) + Nothing -> do + off <- readFastMutInt symtab_next + writeFastMutInt symtab_next (off+1) + writeIORef symtab_map_ref + $! Map.insert val off symtab_map + put_ bh (fromIntegral off :: Word32) + +getGenericSymtab :: Binary a => SymbolTable a -> ReadBinHandle -> IO a +getGenericSymtab symtab bh = do + i :: Word32 <- get bh + return $! symtab ! fromIntegral i + --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- ===================================== compiler/Language/Haskell/Syntax/Type.hs ===================================== @@ -78,6 +78,7 @@ import Data.Eq import Data.Bool import Data.Char import Prelude (Integer, length) +import Data.Ord (Ord) {- ************************************************************************ @@ -91,7 +92,7 @@ import Prelude (Integer, length) data PromotionFlag = NotPromoted | IsPromoted - deriving ( Eq, Data ) + deriving ( Eq, Data, Ord ) isPromoted :: PromotionFlag -> Bool isPromoted IsPromoted = True ===================================== compiler/Language/Haskell/Syntax/Type.hs-boot ===================================== @@ -2,6 +2,7 @@ module Language.Haskell.Syntax.Type where import Data.Bool import Data.Eq +import Data.Ord {- ************************************************************************ @@ -17,5 +18,6 @@ data PromotionFlag | IsPromoted instance Eq PromotionFlag +instance Ord PromotionFlag isPromoted :: PromotionFlag -> Bool ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit edf742131e272fc29c6d6eae549b0fe37eea11b9 +Subproject commit fc8a6e6bbf4156ba01f0721a6d61d0daec36074d View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/748bf10071f58a54f61baf8c33a4131fddb8f679 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/748bf10071f58a54f61baf8c33a4131fddb8f679 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 13:47:05 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Fri, 05 Apr 2024 09:47:05 -0400 Subject: [Git][ghc/ghc][wip/fendor/ifacetype-deduplication] Add deduplication table for `IfaceType` Message-ID: <661000d965de1_180afb19da6d855253@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ifacetype-deduplication at Glasgow Haskell Compiler / GHC Commits: 043ed148 by Matthew Pickering at 2024-04-05T15:41:41+02:00 Add deduplication table for `IfaceType` The type `IfaceType` is a highly redundant, tree-like data structure. While benchmarking, we realised that the high redundancy of `IfaceType` causes high memory consumption in GHCi sessions. We fix this by adding a deduplication table to the serialisation of `ModIface`, similar to how we deduplicate `Name`s and `FastString`s. When reading the interface file back, the table allows us to automatically share identical values of `IfaceType`. This deduplication has the beneficial side effect to additionally reduce the size of the on-disk interface files tremendously. On the agda code base, we reduce the size from 28 MB to 16 MB. When `-fwrite-simplified-core` is enabled, we reduce the size from 112 MB to 22 MB. We have to add an `Ord` instance to `IfaceType` in order to store it efficiently for look up operations. This is mostly straightforward, we change occurrences of `FastString` with `LexicalFastString` and add a newtype definition for `IfLclName = LexicalFastString`. Bump haddock submodule for `IfLclName` newtype changes. - - - - - 20 changed files: - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Utils/Binary.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/Language/Haskell/Syntax/Type.hs-boot - utils/haddock Changes: ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -952,13 +952,13 @@ data CoSel -- See Note [SelCo] | SelForAll -- Decomposes (forall a. co) - deriving( Eq, Data.Data ) + deriving( Eq, Data.Data, Ord ) data FunSel -- See Note [SelCo] = SelMult -- Multiplicity | SelArg -- Argument of function | SelRes -- Result of function - deriving( Eq, Data.Data ) + deriving( Eq, Data.Data, Ord ) type CoercionN = Coercion -- always nominal type CoercionR = Coercion -- always representational ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -121,7 +121,7 @@ toIfaceTvBndr :: TyVar -> IfaceTvBndr toIfaceTvBndr = toIfaceTvBndrX emptyVarSet toIfaceTvBndrX :: VarSet -> TyVar -> IfaceTvBndr -toIfaceTvBndrX fr tyvar = ( occNameFS (getOccName tyvar) +toIfaceTvBndrX fr tyvar = ( mkIfLclName (occNameFS (getOccName tyvar)) , toIfaceTypeX fr (tyVarKind tyvar) ) @@ -133,7 +133,7 @@ toIfaceIdBndr = toIfaceIdBndrX emptyVarSet toIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr toIfaceIdBndrX fr covar = ( toIfaceType (idMult covar) - , occNameFS (getOccName covar) + , mkIfLclName (occNameFS (getOccName covar)) , toIfaceTypeX fr (varType covar) ) @@ -218,11 +218,11 @@ toIfaceTypeX fr (TyConApp tc tys) arity = tyConArity tc n_tys = length tys -toIfaceTyVar :: TyVar -> FastString -toIfaceTyVar = occNameFS . getOccName +toIfaceTyVar :: TyVar -> IfLclName +toIfaceTyVar = mkIfLclName . occNameFS . getOccName -toIfaceCoVar :: CoVar -> FastString -toIfaceCoVar = occNameFS . getOccName +toIfaceCoVar :: CoVar -> IfLclName +toIfaceCoVar = mkIfLclName . occNameFS . getOccName ---------------- toIfaceTyCon :: TyCon -> IfaceTyCon @@ -264,7 +264,7 @@ toIfaceTyCon_name n = IfaceTyCon n info toIfaceTyLit :: TyLit -> IfaceTyLit toIfaceTyLit (NumTyLit x) = IfaceNumTyLit x -toIfaceTyLit (StrTyLit x) = IfaceStrTyLit x +toIfaceTyLit (StrTyLit x) = IfaceStrTyLit (LexicalFastString x) toIfaceTyLit (CharTyLit x) = IfaceCharTyLit x ---------------- @@ -296,7 +296,7 @@ toIfaceCoercionX fr co go (InstCo co arg) = IfaceInstCo (go co) (go arg) go (KindCo c) = IfaceKindCo (go c) go (SubCo co) = IfaceSubCo (go co) - go (AxiomRuleCo co cs) = IfaceAxiomRuleCo (coaxrName co) (map go cs) + go (AxiomRuleCo co cs) = IfaceAxiomRuleCo (mkIfLclName (coaxrName co)) (map go cs) go (AxiomInstCo c i cs) = IfaceAxiomInstCo (coAxiomName c) i (map go cs) go (UnivCo p r t1 t2) = IfaceUnivCo (go_prov p) r (toIfaceTypeX fr t1) @@ -433,7 +433,7 @@ toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang toIfaceSrcBang (HsSrcBang _ unpk bang) = IfSrcBang unpk bang toIfaceLetBndr :: Id -> IfaceLetBndr -toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id)) +toIfaceLetBndr id = IfLetBndr (mkIfLclName (occNameFS (getOccName id))) (toIfaceType (idType id)) (toIfaceIdInfo (idInfo id)) (idJoinPointHood id) @@ -444,7 +444,7 @@ toIfaceTopBndr :: Id -> IfaceTopBndrInfo toIfaceTopBndr id = if isExternalName name then IfGblTopBndr name - else IfLclTopBndr (occNameFS (getOccName id)) (toIfaceType (idType id)) + else IfLclTopBndr (mkIfLclName (occNameFS (getOccName id))) (toIfaceType (idType id)) (toIfaceIdInfo (idInfo id)) (toIfaceIdDetails (idDetails id)) where name = getName id @@ -555,7 +555,7 @@ toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfac toIfaceExpr (App f a) = toIfaceApp f [a] toIfaceExpr (Case s x ty as) | null as = IfaceECase (toIfaceExpr s) (toIfaceType ty) - | otherwise = IfaceCase (toIfaceExpr s) (getOccFS x) (map toIfaceAlt as) + | otherwise = IfaceCase (toIfaceExpr s) (mkIfLclName (getOccFS x)) (map toIfaceAlt as) toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e) toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceCoercion co) toIfaceExpr (Tick t e) = IfaceTick (toIfaceTickish t) (toIfaceExpr e) @@ -610,7 +610,7 @@ toIfaceTopBind b = --------------------- toIfaceAlt :: CoreAlt -> IfaceAlt -toIfaceAlt (Alt c bs r) = IfaceAlt (toIfaceCon c) (map getOccFS bs) (toIfaceExpr r) +toIfaceAlt (Alt c bs r) = IfaceAlt (toIfaceCon c) (map (mkIfLclName . getOccFS) bs) (toIfaceExpr r) --------------------- toIfaceCon :: AltCon -> IfaceConAlt @@ -655,7 +655,7 @@ toIfaceVar v -- Foreign calls have special syntax | isExternalName name = IfaceExt name - | otherwise = IfaceLcl (occNameFS $ nameOccName name) + | otherwise = IfaceLcl (mkIfLclName (occNameFS $ nameOccName name)) where name = idName v ty = idType v ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -283,13 +283,16 @@ instance Ord NonDetFastString where -- `lexicalCompareFS` (i.e. which compares FastStrings on their String -- representation). Hence it is deterministic from one run to the other. newtype LexicalFastString - = LexicalFastString FastString + = LexicalFastString { getLexicalFastString :: FastString } deriving newtype (Eq, Show) deriving stock Data instance Ord LexicalFastString where compare (LexicalFastString fs1) (LexicalFastString fs2) = lexicalCompareFS fs1 fs2 +instance NFData LexicalFastString where + rnf (LexicalFastString f) = rnf f + -- ----------------------------------------------------------------------------- -- Construction ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -54,6 +54,9 @@ import Data.Char import Data.Word import Data.IORef import Control.Monad +import GHC.Iface.Type (IfaceType, getIfaceType, putIfaceType) +import System.IO.Unsafe + -- --------------------------------------------------------------------------- -- Reading and writing binary interface files @@ -158,9 +161,13 @@ getWithUserData name_cache bh = do -- Reading names has the side effect of adding them into the given NameCache. getTables :: NameCache -> ReadBinHandle -> IO ReadBinHandle getTables name_cache bh = do - fsReaderTable <- initFastStringReaderTable - nameReaderTable <- (initReadNameCachedBinary name_cache) + bhRef <- newIORef (error "used too soon") + -- It is important this is passed to 'getTable' + ud <- unsafeInterleaveIO (readIORef bhRef) + fsReaderTable <- initFastStringReaderTable + nameReaderTable <- initReadNameCachedBinary name_cache + ifaceTypeReaderTable <- initReadIfaceTypeTable ud -- The order of these deserialisation matters! -- @@ -168,14 +175,21 @@ getTables name_cache bh = do fsTable <- Binary.forwardGet bh (getTable fsReaderTable bh) let fsReader = mkReaderFromTable fsReaderTable fsTable - bhFs = addReaderToUserData (mkSomeBinaryReader fsReader) bh + bhFs = addReaderToUserData fsReader bh + nameTable <- Binary.forwardGet bh (getTable nameReaderTable bhFs) let nameReader = mkReaderFromTable nameReaderTable nameTable - bhName = addReaderToUserData (mkSomeBinaryReader nameReader) bhFs + bhName = addReaderToUserData nameReader bhFs - pure bhName + ifaceTypeTable <- Binary.forwardGet bh (getTable ifaceTypeReaderTable bhName) + let + ifaceTypeReader = mkReaderFromTable ifaceTypeReaderTable ifaceTypeTable + bhIfaceType = addReaderToUserData ifaceTypeReader bhName + + writeIORef bhRef (getReaderUserData bhIfaceType) + pure bhIfaceType -- | Write an interface file. -- @@ -238,11 +252,13 @@ putWithTables :: WriteBinHandle -> (WriteBinHandle -> IO b) -> IO (Int, Int, b) putWithTables bh' put_payload = do (fast_wt, fsWriter) <- initFastStringWriterTable (name_wt, nameWriter) <- initWriteNameTable + (ifaceType_wt, ifaceTypeWriter) <- initWriteIfaceType let writerUserData = mkWriterUserData [ mkSomeBinaryWriter @FastString fsWriter , mkSomeBinaryWriter @Name nameWriter , mkSomeBinaryWriter @BindingName $ mkWriter (\bh name -> putEntry nameWriter bh (getBindingName name)) + , mkSomeBinaryWriter @IfaceType ifaceTypeWriter ] let bh = setWriterUserData bh' writerUserData @@ -250,7 +266,7 @@ putWithTables bh' put_payload = do -- The order of these entries matters! -- -- See Note [Iface Binary Serialiser Order] for details. - putAllTables bh [fast_wt, name_wt] $ do + putAllTables bh [fast_wt, name_wt, ifaceType_wt] $ do put_payload bh return (name_count, fs_count, r) @@ -335,6 +351,24 @@ Here, a visualisation of the table structure we currently have: -- The symbol table -- +initReadIfaceTypeTable :: ReaderUserData -> IO (ReaderTable IfaceType) +initReadIfaceTypeTable ud = do + pure $ + ReaderTable + { getTable = getGenericSymbolTable (\bh -> getIfaceType (setReaderUserData bh ud)) + , mkReaderFromTable = \tbl -> mkReader (getGenericSymtab tbl) + } + +initWriteIfaceType :: IO (WriterTable, BinaryWriter IfaceType) +initWriteIfaceType = do + sym_tab <- initGenericSymbolTable + pure + ( WriterTable + { putTable = putGenericSymbolTable sym_tab (lazyPut' putIfaceType) + } + , mkWriter $ putGenericSymTab sym_tab + ) + initReadNameCachedBinary :: NameCache -> IO (ReaderTable Name) initReadNameCachedBinary cache = do ===================================== compiler/GHC/Iface/Decl.hs ===================================== @@ -45,7 +45,6 @@ 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 @@ -147,7 +146,7 @@ tyConToIfaceDecl env tycon | Just fam_flav <- famTyConFlav_maybe tycon = ( tc_env1 , IfaceFamily { ifName = getName tycon, - ifResVar = if_res_var, + ifResVar = mkIfLclName <$> if_res_var, ifFamFlav = to_if_fam_flav fam_flav, ifBinders = if_binders, ifResKind = if_res_kind, @@ -288,7 +287,7 @@ classToIfaceDecl env clas ifClassCtxt = tidyToIfaceContext env1 sc_theta, ifATs = map toIfaceAT clas_ats, ifSigs = map toIfaceClassOp op_stuff, - ifMinDef = toIfaceBooleanFormula $ fmap getOccFS (classMinimalDef clas) + ifMinDef = toIfaceBooleanFormula $ fmap (mkIfLclName . getOccFS) (classMinimalDef clas) } (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon) @@ -334,7 +333,7 @@ tidyTyConBinder env@(_, subst) tvb@(Bndr tv vis) tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder]) tidyTyConBinders = mapAccumL tidyTyConBinder -tidyTyVar :: TidyEnv -> TyVar -> FastString +tidyTyVar :: TidyEnv -> TyVar -> IfLclName tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv) toIfaceBooleanFormula :: BooleanFormula IfLclName -> IfaceBooleanFormula ===================================== compiler/GHC/Iface/Env.hs ===================================== @@ -34,7 +34,6 @@ import GHC.Runtime.Context import GHC.Unit.Module import GHC.Unit.Module.ModIface -import GHC.Data.FastString import GHC.Data.FastString.Env import GHC.Types.Var @@ -190,10 +189,10 @@ setNameModule (Just m) n = ************************************************************************ -} -tcIfaceLclId :: FastString -> IfL Id +tcIfaceLclId :: IfLclName -> IfL Id tcIfaceLclId occ = do { lcl <- getLclEnv - ; case lookupFsEnv (if_id_env lcl) occ of + ; case lookupFsEnv (if_id_env lcl) (ifLclNameFS occ) of Just ty_var -> return ty_var Nothing -> failIfM $ vcat @@ -209,10 +208,10 @@ extendIfaceIdEnv ids in env { if_id_env = id_env' } -tcIfaceTyVar :: FastString -> IfL TyVar +tcIfaceTyVar :: IfLclName -> IfL TyVar tcIfaceTyVar occ = do { lcl <- getLclEnv - ; case lookupFsEnv (if_tv_env lcl) occ of + ; case lookupFsEnv (if_tv_env lcl) (ifLclNameFS occ) of Just ty_var -> return ty_var Nothing -> failIfM (text "Iface type variable out of scope: " <+> ppr occ) } @@ -220,15 +219,15 @@ tcIfaceTyVar occ lookupIfaceTyVar :: IfaceTvBndr -> IfL (Maybe TyVar) lookupIfaceTyVar (occ, _) = do { lcl <- getLclEnv - ; return (lookupFsEnv (if_tv_env lcl) occ) } + ; return (lookupFsEnv (if_tv_env lcl) (ifLclNameFS occ)) } lookupIfaceVar :: IfaceBndr -> IfL (Maybe TyCoVar) lookupIfaceVar (IfaceIdBndr (_, occ, _)) = do { lcl <- getLclEnv - ; return (lookupFsEnv (if_id_env lcl) occ) } + ; return (lookupFsEnv (if_id_env lcl) (ifLclNameFS occ)) } lookupIfaceVar (IfaceTvBndr (occ, _)) = do { lcl <- getLclEnv - ; return (lookupFsEnv (if_tv_env lcl) occ) } + ; return (lookupFsEnv (if_tv_env lcl) (ifLclNameFS occ)) } extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a extendIfaceTyVarEnv tyvars ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Types.Unique.FM import qualified Data.Array as A import qualified Data.Array.IO as A import qualified Data.Array.Unsafe as A +import Data.Function ( (&) ) import Data.IORef import Data.ByteString ( ByteString ) import qualified Data.ByteString as BS @@ -43,6 +44,7 @@ import System.Directory ( createDirectoryIfMissing ) import System.FilePath ( takeDirectory ) import GHC.Iface.Ext.Types +import GHC.Iface.Syntax (getIfaceType, putIfaceType ) data HieSymbolTable = HieSymbolTable { hie_symtab_next :: !FastMutInt @@ -105,10 +107,13 @@ writeHieFile hie_file_path hiefile = do hie_dict_map = dict_map_ref } -- put the main thing - let bh = setWriterUserData bh0 - $ newWriteState (putName hie_symtab) - (putName hie_symtab) - (putFastString hie_dict) + let bh = setWriterUserData bh0 $ mkWriterUserData + [ mkSomeBinaryWriter (mkWriter putIfaceType) + , mkSomeBinaryWriter (mkWriter $ putName hie_symtab) + , mkSomeBinaryWriter (simpleBindingNameWriter $ mkWriter $ putName hie_symtab) + , mkSomeBinaryWriter (mkWriter $ putFastString hie_dict) + ] + put_ bh hiefile -- write the symtab pointer at the front of the file @@ -219,13 +224,13 @@ readHieFileContents bh0 name_cache = do dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data bh1 <- do - let bh1 = setReaderUserData bh0 - $ newReadState (error "getSymtabName") - (getDictFastString dict) + let bh1 = addReaderToUserData (mkReader $ getDictFastString dict) bh0 symtab <- get_symbol_table bh1 - let bh1' = setReaderUserData bh1 - $ newReadState (getSymTabName symtab) - (getDictFastString dict) + let bh1' = bh1 + & addReaderToUserData (mkReader getIfaceType) + & addReaderToUserData (mkReader $ getSymTabName symtab) + & addReaderToUserData (simpleBindingNameReader $ mkReader $ getSymTabName symtab) + & addReaderToUserData (mkReader getIfaceType) return bh1' -- load the actual data ===================================== compiler/GHC/Iface/Ext/Utils.hs ===================================== @@ -162,15 +162,15 @@ getEvidenceTree refmap var = go emptyNameSet var hieTypeToIface :: HieTypeFix -> IfaceType hieTypeToIface = foldType go where - go (HTyVarTy n) = IfaceTyVar $ occNameFS $ getOccName n + go (HTyVarTy n) = IfaceTyVar $ (mkIfLclName (occNameFS $ getOccName n)) go (HAppTy a b) = IfaceAppTy a (hieToIfaceArgs b) go (HLitTy l) = IfaceLitTy l - go (HForAllTy ((n,k),af) t) = let b = (occNameFS $ getOccName n, k) + go (HForAllTy ((n,k),af) t) = let b = (mkIfLclName (occNameFS $ getOccName n), k) in IfaceForAllTy (Bndr (IfaceTvBndr b) af) t go (HFunTy w a b) = IfaceFunTy visArgTypeLike w a b go (HQualTy pred b) = IfaceFunTy invisArgTypeLike many_ty pred b go (HCastTy a) = a - go HCoercionTy = IfaceTyVar "" + go HCoercionTy = IfaceTyVar (mkIfLclName "") go (HTyConApp a xs) = IfaceTyConApp a (hieToIfaceArgs xs) -- This isn't fully faithful - we can't produce the 'Inferred' case ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -1216,8 +1216,8 @@ addFingerprints hsc_env iface0 getOcc (IfLclTopBndr fs _ _ details) = case details of IfRecSelId { ifRecSelFirstCon = first_con } - -> mkRecFieldOccFS (getOccFS first_con) fs - _ -> mkVarOccFS fs + -> mkRecFieldOccFS (getOccFS first_con) (ifLclNameFS fs) + _ -> mkVarOccFS (ifLclNameFS fs) binding_key (IfaceNonRec b _) = IfaceNonRec (getOcc b) () binding_key (IfaceRec bs) = IfaceRec (map (\(b, _) -> (getOcc b, ())) bs) ===================================== compiler/GHC/Iface/Recomp/Binary.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Utils.Fingerprint import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Panic.Plain +import GHC.Iface.Type (putIfaceType) fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f @@ -34,8 +35,12 @@ computeFingerprint put_nonbinding_name a = do put_ bh a fingerprintBinMem bh where - set_user_data bh = - setWriterUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS + set_user_data bh = setWriterUserData bh $ mkWriterUserData + [ mkSomeBinaryWriter $ mkWriter putIfaceType + , mkSomeBinaryWriter $ mkWriter put_nonbinding_name + , mkSomeBinaryWriter $ simpleBindingNameWriter $ mkWriter putNameLiterally + , mkSomeBinaryWriter $ mkWriter putFS + ] -- | Used when we want to fingerprint a structure without depending on the -- fingerprints of external Names that it refers to. ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -632,6 +632,7 @@ data IfaceExpr | IfaceFCall ForeignCall IfaceType | IfaceTick IfaceTickish IfaceExpr -- from Tick tickish E + data IfaceTickish = IfaceHpcTick Module Int -- from HpcTick x | IfaceSCC CostCentre Bool Bool -- from ProfNote @@ -1026,7 +1027,7 @@ pprIfaceDecl ss (IfaceClass { ifName = clas pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions text "{-# MINIMAL" <+> pprBooleanFormula - (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+> + (\_ def -> cparen (isLexSym def) (ppr def)) 0 (fmap ifLclNameFS minDef) <+> text "#-}" -- See Note [Suppressing binder signatures] in GHC.Iface.Type ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -10,7 +10,8 @@ This module defines interface types and binders {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE LambdaCase #-} module GHC.Iface.Type ( - IfExtName, IfLclName, + IfExtName, + IfLclName(..), mkIfLclName, ifLclNameFS, IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..), IfaceMCoercion(..), @@ -32,6 +33,8 @@ module GHC.Iface.Type ( ifForAllBndrVar, ifForAllBndrName, ifaceBndrName, ifTyConBinderVar, ifTyConBinderName, + -- Binary utilities + putIfaceType, getIfaceType, -- Equality testing isIfaceLiftedTypeKind, @@ -90,9 +93,11 @@ import GHC.Utils.Panic import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar ) import Control.DeepSeq +import Data.Proxy import Control.Monad ((<$!>)) +import Control.Arrow (first) import qualified Data.Semigroup as Semi -import Data.Maybe( isJust ) +import Data.Maybe (isJust) {- ************************************************************************ @@ -102,7 +107,16 @@ import Data.Maybe( isJust ) ************************************************************************ -} -type IfLclName = FastString -- A local name in iface syntax +-- | A local name in iface syntax +newtype IfLclName = IfLclName + { getIfLclName :: LexicalFastString + } deriving (Eq, Ord, Show) + +ifLclNameFS :: IfLclName -> FastString +ifLclNameFS = getLexicalFastString . getIfLclName + +mkIfLclName :: FastString -> IfLclName +mkIfLclName = IfLclName . LexicalFastString type IfExtName = Name -- An External or WiredIn Name can appear in Iface syntax -- (However Internal or System Names never should) @@ -110,6 +124,8 @@ type IfExtName = Name -- An External or WiredIn Name can appear in Iface synta data IfaceBndr -- Local (non-top-level) binders = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr + deriving (Eq, Ord) + type IfaceIdBndr = (IfaceType, IfLclName, IfaceType) type IfaceTvBndr = (IfLclName, IfaceKind) @@ -178,6 +194,7 @@ data IfaceType -- In an experiment, removing IfaceTupleTy resulted in a 0.75% regression -- in interface file size (in GHC's boot libraries). -- See !3987. + deriving (Eq, Ord) type IfaceMult = IfaceType @@ -186,9 +203,9 @@ type IfaceContext = [IfacePredType] data IfaceTyLit = IfaceNumTyLit Integer - | IfaceStrTyLit FastString + | IfaceStrTyLit LexicalFastString | IfaceCharTyLit Char - deriving (Eq) + deriving (Eq, Ord) type IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis type IfaceForAllBndr = VarBndr IfaceBndr ForAllTyFlag @@ -230,6 +247,7 @@ data IfaceAppArgs -- arguments in @{...}. IfaceAppArgs -- The rest of the arguments + deriving (Eq, Ord) instance Semi.Semigroup IfaceAppArgs where IA_Nil <> xs = xs @@ -256,7 +274,7 @@ data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName -- See Note [Sharing IfaceTyConInfo] for why -- sharing is so important for 'IfaceTyConInfo'. } - deriving (Eq) + deriving (Eq, Ord) -- | The various types of TyCons which have special, built-in syntax. data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon @@ -276,7 +294,7 @@ data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon -- that is actually being applied to two types -- of the same kind. This affects pretty-printing -- only: see Note [Equality predicates in IfaceType] - deriving (Eq) + deriving (Eq, Ord) instance Outputable IfaceTyConSort where ppr IfaceNormalTyCon = text "normal" @@ -370,7 +388,7 @@ data IfaceTyConInfo -- Used only to guide pretty-printing -- should be printed as 'D to distinguish it from -- an existing type constructor D. , ifaceTyConSort :: IfaceTyConSort } - deriving (Eq) + deriving (Eq, Ord) -- | This smart constructor allows sharing of the two most common -- cases. See Note [Sharing IfaceTyConInfo] @@ -420,7 +438,7 @@ This one change leads to an 15% reduction in residency for GHC when embedding data IfaceMCoercion = IfaceMRefl - | IfaceMCo IfaceCoercion + | IfaceMCo IfaceCoercion deriving (Eq, Ord) data IfaceCoercion = IfaceReflCo IfaceType @@ -445,11 +463,13 @@ data IfaceCoercion | IfaceSubCo IfaceCoercion | IfaceFreeCoVar CoVar -- See Note [Free tyvars in IfaceType] | IfaceHoleCo CoVar -- ^ See Note [Holes in IfaceCoercion] + deriving (Eq, Ord) data IfaceUnivCoProv = IfacePhantomProv IfaceCoercion | IfaceProofIrrelProv IfaceCoercion | IfacePluginProv String + deriving (Eq, Ord) {- Note [Holes in IfaceCoercion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -621,11 +641,11 @@ type IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType] mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst -- See Note [Substitution on IfaceType] -mkIfaceTySubst eq_spec = mkFsEnv eq_spec +mkIfaceTySubst eq_spec = mkFsEnv (map (first ifLclNameFS) eq_spec) inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool -- See Note [Substitution on IfaceType] -inDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst fs) +inDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst (ifLclNameFS fs)) substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType -- See Note [Substitution on IfaceType] @@ -681,7 +701,7 @@ substIfaceAppArgs env args substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType substIfaceTyVar env tv - | Just ty <- lookupFsEnv env tv = ty + | Just ty <- lookupFsEnv env (ifLclNameFS tv) = ty | otherwise = IfaceTyVar tv @@ -1190,7 +1210,7 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 , Just substituted_ty <- check_substitution var_kind - = let subs' = extendFsEnv subs var substituted_ty + = let subs' = extendFsEnv subs (ifLclNameFS var) substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall in go subs' True ty @@ -1198,7 +1218,7 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty go subs rank1 (IfaceForAllTy bndr ty) = IfaceForAllTy (go_ifacebndr subs bndr) (go subs rank1 ty) - go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs (ifLclNameFS tv) of Just s -> s Nothing -> ty @@ -1626,7 +1646,7 @@ pprTyTcApp ctxt_prec tc tys = , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) Required (IA_Arg ty Required IA_Nil) <- tys -> maybeParen ctxt_prec funPrec - $ char '?' <> ftext n <> text "::" <> ppr_ty topPrec ty + $ char '?' <> ftext (getLexicalFastString n) <> text "::" <> ppr_ty topPrec ty | IfaceTupleTyCon arity sort <- ifaceTyConSort info , not debug @@ -2014,6 +2034,9 @@ pprIfaceUnivCoProv (IfacePluginProv s) = text "plugin" <+> doubleQuotes (text s) ------------------- +instance Outputable IfLclName where + ppr = ppr . ifLclNameFS + instance Outputable IfaceTyCon where ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc) @@ -2171,38 +2194,47 @@ ppr_parend_preds :: [IfacePredType] -> SDoc ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds))) instance Binary IfaceType where - put_ _ (IfaceFreeTyVar tv) - = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv) - - put_ bh (IfaceForAllTy aa ab) = do - putByte bh 0 - put_ bh aa - put_ bh ab - put_ bh (IfaceTyVar ad) = do - putByte bh 1 - put_ bh ad - put_ bh (IfaceAppTy ae af) = do - putByte bh 2 - put_ bh ae - put_ bh af - put_ bh (IfaceFunTy af aw ag ah) = do - putByte bh 3 - put_ bh af - put_ bh aw - put_ bh ag - put_ bh ah - put_ bh (IfaceTyConApp tc tys) - = do { putByte bh 5; put_ bh tc; put_ bh tys } - put_ bh (IfaceCastTy a b) - = do { putByte bh 6; put_ bh a; put_ bh b } - put_ bh (IfaceCoercionTy a) - = do { putByte bh 7; put_ bh a } - put_ bh (IfaceTupleTy s i tys) - = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys } - put_ bh (IfaceLitTy n) - = do { putByte bh 9; put_ bh n } - - get bh = do + put_ bh tyCon = case findUserDataWriter Proxy bh of + tbl -> putEntry tbl bh tyCon + + get bh = case findUserDataReader Proxy bh of + tbl -> getEntry tbl bh + + +putIfaceType :: WriteBinHandle -> IfaceType -> IO () +putIfaceType _ (IfaceFreeTyVar tv) + = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv) + +putIfaceType bh (IfaceForAllTy aa ab) = do + putByte bh 0 + put_ bh aa + put_ bh ab +putIfaceType bh (IfaceTyVar ad) = do + putByte bh 1 + put_ bh ad +putIfaceType bh (IfaceAppTy ae af) = do + putByte bh 2 + put_ bh ae + put_ bh af +putIfaceType bh (IfaceFunTy af aw ag ah) = do + putByte bh 3 + put_ bh af + put_ bh aw + put_ bh ag + put_ bh ah +putIfaceType bh (IfaceTyConApp tc tys) + = do { putByte bh 5; put_ bh tc; put_ bh tys } +putIfaceType bh (IfaceCastTy a b) + = do { putByte bh 6; put_ bh a; put_ bh b } +putIfaceType bh (IfaceCoercionTy a) + = do { putByte bh 7; put_ bh a } +putIfaceType bh (IfaceTupleTy s i tys) + = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys } +putIfaceType bh (IfaceLitTy n) + = do { putByte bh 9; put_ bh n } + +getIfaceType :: HasCallStack => ReadBinHandle -> IO IfaceType +getIfaceType bh = do h <- getByte bh case h of 0 -> do aa <- get bh @@ -2230,6 +2262,13 @@ instance Binary IfaceType where _ -> do n <- get bh return (IfaceLitTy n) +instance Binary IfLclName where + put_ bh = put_ bh . ifLclNameFS + + get bh = do + fs <- get bh + pure $ IfLclName $ LexicalFastString fs + instance Binary IfaceMCoercion where put_ bh IfaceMRefl = putByte bh 1 @@ -2475,6 +2514,9 @@ instance NFData IfaceTyConSort where IfaceSumTyCon arity -> rnf arity IfaceEqualityTyCon -> () +instance NFData IfLclName where + rnf (IfLclName lfs) = rnf lfs + instance NFData IfaceTyConInfo where rnf (IfaceTyConInfo f s) = f `seq` rnf s ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -733,7 +733,7 @@ tc_iface_decl parent _ (IfaceFamily {ifName = tc_name, { res_kind' <- tcIfaceType res_kind -- Note [Synonym kind loop] ; rhs <- forkM (mk_doc tc_name) $ tc_fam_flav tc_name fam_flav - ; res_name <- traverse (newIfaceName . mkTyVarOccFS) res + ; res_name <- traverse (newIfaceName . mkTyVarOccFS . ifLclNameFS) res ; let tycon = mkFamilyTyCon tc_name binders' res_kind' res_name rhs parent inj ; return (ATyCon tycon) } where @@ -782,7 +782,7 @@ tc_iface_decl _parent ignore_prags ; 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 + ; mindef <- traverse (lookupIfaceTop . mkVarOccFS . ifLclNameFS) mindef_occ ; cls <- fixM $ \ cls -> do { ats <- mapM (tc_at cls) rdr_ats ; traceIf (text "tc-iface-class4" <+> ppr tc_name) @@ -936,8 +936,8 @@ mk_top_id (IfLclTopBndr raw_name iface_type info details) = do ; let occ = case details' of RecSelId { sel_tycon = parent } -> let con_fs = getOccFS $ recSelFirstConName parent - in mkRecFieldOccFS con_fs raw_name - _ -> mkVarOccFS raw_name + in mkRecFieldOccFS con_fs (ifLclNameFS raw_name) + _ -> mkVarOccFS (ifLclNameFS raw_name) ; name <- newIfaceName occ } info' <- tcIdInfo False TopLevel name ty info let new_id = mkGlobalId details' name ty info' @@ -1441,7 +1441,7 @@ tcIfaceCtxt sts = mapM tcIfaceType sts ----------------------------------------- tcIfaceTyLit :: IfaceTyLit -> IfL TyLit tcIfaceTyLit (IfaceNumTyLit n) = return (NumTyLit n) -tcIfaceTyLit (IfaceStrTyLit n) = return (StrTyLit n) +tcIfaceTyLit (IfaceStrTyLit n) = return (StrTyLit (getLexicalFastString n)) tcIfaceTyLit (IfaceCharTyLit n) = return (CharTyLit n) {- @@ -1485,7 +1485,7 @@ tcIfaceCo = go go (IfaceFreeCoVar c) = pprPanic "tcIfaceCo:IfaceFreeCoVar" (ppr c) go (IfaceHoleCo c) = pprPanic "tcIfaceCo:IfaceHoleCo" (ppr c) - go_var :: FastString -> IfL CoVar + go_var :: IfLclName -> IfL CoVar go_var = tcIfaceLclId tcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance @@ -1561,7 +1561,7 @@ tcIfaceExpr (IfaceECase scrut ty) tcIfaceExpr (IfaceCase scrut case_bndr alts) = do scrut' <- tcIfaceExpr scrut - case_bndr_name <- newIfaceName (mkVarOccFS case_bndr) + case_bndr_name <- newIfaceName (mkVarOccFS (ifLclNameFS case_bndr)) let scrut_ty = exprType scrut' case_mult = ManyTy @@ -1580,7 +1580,7 @@ tcIfaceExpr (IfaceCase scrut case_bndr alts) = do return (Case scrut' case_bndr' (coreAltsType alts') alts') tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) - = do { name <- newIfaceName (mkVarOccFS fs) + = do { name <- newIfaceName (mkVarOccFS (ifLclNameFS fs)) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel name ty' info @@ -1598,7 +1598,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) ; return (Let (Rec pairs') body') } } where tc_rec_bndr (IfLetBndr fs ty _ ji) - = do { name <- newIfaceName (mkVarOccFS fs) + = do { name <- newIfaceName (mkVarOccFS (ifLclNameFS fs)) ; ty' <- tcIfaceType ty ; return (mkLocalId name ManyTy ty' `asJoinId_maybe` ji) } tc_pair (IfLetBndr _ _ info _, rhs) id @@ -1655,12 +1655,12 @@ tcIfaceAlt scrut mult (tycon, inst_tys) (IfaceAlt (IfaceDataAlt data_occ) arg_st (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon))) ; tcIfaceDataAlt mult con inst_tys arg_strs rhs } -tcIfaceDataAlt :: Mult -> DataCon -> [Type] -> [FastString] -> IfaceExpr +tcIfaceDataAlt :: Mult -> DataCon -> [Type] -> [IfLclName] -> IfaceExpr -> IfL CoreAlt tcIfaceDataAlt mult con inst_tys arg_strs rhs = do { uniqs <- getUniquesM ; let (ex_tvs, arg_ids) - = dataConRepFSInstPat arg_strs uniqs mult con inst_tys + = dataConRepFSInstPat (map ifLclNameFS arg_strs) uniqs mult con inst_tys ; rhs' <- extendIfaceEnvs ex_tvs $ extendIfaceIdEnv arg_ids $ @@ -2031,7 +2031,7 @@ tcIfaceCoAxiomRule :: IfLclName -> IfL CoAxiomRule -- - axioms for type-level literals (Nat and Symbol), -- enumerated in typeNatCoAxiomRules tcIfaceCoAxiomRule n - | Just ax <- lookupUFM typeNatCoAxiomRules n + | Just ax <- lookupUFM typeNatCoAxiomRules (ifLclNameFS n) = return ax | otherwise = pprPanic "tcIfaceCoAxiomRule" (ppr n) @@ -2075,7 +2075,7 @@ tcIfaceImplicit n = do bindIfaceId :: IfaceIdBndr -> (Id -> IfL a) -> IfL a bindIfaceId (w, fs, ty) thing_inside - = do { name <- newIfaceName (mkVarOccFS fs) + = do { name <- newIfaceName (mkVarOccFS (ifLclNameFS fs)) ; ty' <- tcIfaceType ty ; w' <- tcIfaceType w ; let id = mkLocalIdOrCoVar name w' ty' @@ -2118,7 +2118,7 @@ bindIfaceForAllBndr (Bndr (IfaceIdBndr tv) vis) thing_inside bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a bindIfaceTyVar (occ,kind) thing_inside - = do { name <- newIfaceName (mkTyVarOccFS occ) + = do { name <- newIfaceName (mkTyVarOccFS (ifLclNameFS occ)) ; tyvar <- mk_iface_tyvar name kind ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) } ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -314,7 +314,7 @@ putObject bh mod_name deps os = do put_ bh (moduleNameString mod_name) (fs_tbl, fs_writer) <- initFastStringWriterTable - let bh_fs = addWriterToUserData (mkSomeBinaryWriter fs_writer) bh + let bh_fs = addWriterToUserData fs_writer bh forwardPut_ bh (const (putTable fs_tbl bh_fs)) $ do put_ bh_fs deps ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -148,7 +148,7 @@ import qualified Data.Semigroup as Semi ********************************************************************* -} data LeftOrRight = CLeft | CRight - deriving( Eq, Data ) + deriving( Eq, Data, Ord ) pickLR :: LeftOrRight -> (a,a) -> a pickLR CLeft (l,_) = l ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -720,7 +720,7 @@ Currently there are nine different uses of 'VarBndr': data VarBndr var argf = Bndr var argf -- See Note [The VarBndr type and its uses] - deriving( Data ) + deriving( Data, Eq, Ord) -- | Variable Binder -- ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -65,6 +65,8 @@ module GHC.Utils.Binary -- * Lazy Binary I/O lazyGet, lazyPut, + lazyGet', + lazyPut', lazyGetMaybe, lazyPutMaybe, @@ -87,10 +89,17 @@ module GHC.Utils.Binary initFastStringReaderTable, initFastStringWriterTable, putDictionary, getDictionary, putFS, FSTable(..), getDictFastString, putDictFastString, + -- * Generic deduplication table + GenericSymbolTable(..), + initGenericSymbolTable, + getGenericSymtab, putGenericSymTab, + getGenericSymbolTable, putGenericSymbolTable, -- * Newtype wrappers BinSpan(..), BinSrcSpan(..), BinLocated(..), -- * Newtypes for types that have canonically more than one valid encoding BindingName(..), + simpleBindingNameWriter, + simpleBindingNameReader, ) where import GHC.Prelude @@ -103,11 +112,11 @@ import GHC.Utils.Panic.Plain import GHC.Types.Unique.FM import GHC.Data.FastMutInt import GHC.Utils.Fingerprint -import GHC.Utils.Misc (HasCallStack) import GHC.Types.SrcLoc import GHC.Types.Unique import qualified GHC.Data.Strict as Strict import GHC.Utils.Outputable( JoinPointHood(..) ) +import GHC.Utils.Misc ( HasCallStack ) import Control.DeepSeq import Control.Monad ( when, (<$!>), unless, forM_, void ) @@ -127,7 +136,7 @@ import qualified Data.Map.Strict as Map import Data.Set ( Set ) import qualified Data.Set as Set import Data.Time -import Data.List (unfoldr) +import Data.List (sortOn, unfoldr) import Data.Typeable import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) @@ -230,22 +239,26 @@ setReaderUserData bh us = bh { rbm_userData = us } -- | Add 'SomeBinaryReader' as a known binary decoder. -- If a 'BinaryReader' for the associated type already exists in 'ReaderUserData', -- it is overwritten. -addReaderToUserData :: SomeBinaryReader -> ReadBinHandle -> ReadBinHandle -addReaderToUserData cache@(SomeBinaryReader typRep _) bh = bh +addReaderToUserData :: Typeable a => BinaryReader a -> ReadBinHandle -> ReadBinHandle +addReaderToUserData reader bh = bh { rbm_userData = (rbm_userData bh) { ud_reader_data = Map.insert typRep cache (ud_reader_data (rbm_userData bh)) } } + where + cache@(SomeBinaryReader typRep _) = mkSomeBinaryReader reader -- | Add 'SomeBinaryWriter' as a known binary encoder. -- If a 'BinaryWriter' for the associated type already exists in 'WriterUserData', -- it is overwritten. -addWriterToUserData :: SomeBinaryWriter -> WriteBinHandle -> WriteBinHandle -addWriterToUserData cache@(SomeBinaryWriter typRep _) bh = bh +addWriterToUserData :: Typeable a => BinaryWriter a -> WriteBinHandle -> WriteBinHandle +addWriterToUserData writer bh = bh { wbm_userData = (wbm_userData bh) { ud_writer_data = Map.insert typRep cache (ud_writer_data (wbm_userData bh)) } } + where + cache@(SomeBinaryWriter typRep _) = mkSomeBinaryWriter writer -- | Get access to the underlying buffer. withBinBuffer :: WriteBinHandle -> (ByteString -> IO a) -> IO a @@ -1099,24 +1112,35 @@ forwardGet bh get_A = do -- Lazy reading/writing lazyPut :: Binary a => WriteBinHandle -> a -> IO () -lazyPut bh a = do +lazyPut = lazyPut' put_ + +lazyGet :: Binary a => ReadBinHandle -> IO a +lazyGet = lazyGet' Nothing (\_ -> get) + +lazyPut' :: HasCallStack => (WriteBinHandle -> a -> IO ()) -> WriteBinHandle -> a -> IO () +lazyPut' f bh a = do -- output the obj with a ptr to skip over it: pre_a <- tellBinWriter bh put_ bh pre_a -- save a slot for the ptr - put_ bh a -- dump the object + f bh a -- dump the object q <- tellBinWriter bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q seekBinWriter bh q -- finally carry on writing at q -lazyGet :: Binary a => ReadBinHandle -> IO a -lazyGet bh = do +lazyGet' :: HasCallStack => Maybe (IORef ReadBinHandle) -> (Bin () -> ReadBinHandle -> IO a) -> ReadBinHandle -> IO a +lazyGet' mbh f bh = do p <- get bh -- a BinPtr p_a <- tellBinReader bh + -- Do this before to avoid retaining reference to old BH inside the unsafeInterleaveIO. + let !get_inner_bh = maybe (pure bh) readIORef mbh a <- unsafeInterleaveIO $ do - -- NB: Use a fresh off_r variable in the child thread, for thread + -- NB: Use a fresh rbm_off_r variable in the child thread, for thread -- safety. + inner_bh <- get_inner_bh off_r <- newFastMutInt 0 - getAt bh { rbm_off_r = off_r } p_a + let bh' = inner_bh { rbm_off_r = off_r } + seekBinNoExpandReader bh' p_a + f p bh' seekBinNoExpandReader bh p -- skip over the object for now return a @@ -1170,6 +1194,12 @@ lazyGetMaybe bh = do newtype BindingName = BindingName { getBindingName :: Name } deriving ( Eq ) +simpleBindingNameWriter :: BinaryWriter Name -> BinaryWriter BindingName +simpleBindingNameWriter = coerce + +simpleBindingNameReader :: BinaryReader Name -> BinaryReader BindingName +simpleBindingNameReader = coerce + -- | Existential for 'BinaryWriter' with a type witness. data SomeBinaryWriter = forall a . SomeBinaryWriter TypeRep (BinaryWriter a) @@ -1310,6 +1340,80 @@ data WriterTable = WriterTable { putTable :: WriteBinHandle -> IO Int } +-- ---------------------------------------------------------------------------- +-- Common data structures for constructing and maintaining lookup tables for +-- binary serialisation and deserialisation. +-- ---------------------------------------------------------------------------- + +data GenericSymbolTable a = GenericSymbolTable + { gen_symtab_next :: !FastMutInt + -- ^ The next index to use + , gen_symtab_map :: !(IORef (Map.Map a Int)) + -- ^ Given a symbol, find the symbol + } + +initGenericSymbolTable :: IO (GenericSymbolTable a) +initGenericSymbolTable = do + symtab_next <- newFastMutInt 0 + symtab_map <- newIORef Map.empty + pure $ GenericSymbolTable + { gen_symtab_next = symtab_next + , gen_symtab_map = symtab_map + } + +putGenericSymbolTable :: forall a. GenericSymbolTable a -> (WriteBinHandle -> a -> IO ()) -> WriteBinHandle -> IO Int +putGenericSymbolTable gen_sym_tab serialiser bh = do + putGenericSymbolTable bh + where + symtab_map = gen_symtab_map gen_sym_tab + symtab_next = gen_symtab_next gen_sym_tab + putGenericSymbolTable :: HasCallStack => WriteBinHandle -> IO Int + putGenericSymbolTable bh = do + let loop bound = do + d <- readIORef symtab_map + table_count <- readFastMutInt symtab_next + let vs = sortOn fst [(b, a) | (a,b) <- Map.toList d, b >= bound] + case vs of + [] -> return table_count + todo -> do + mapM_ (\n -> serialiser bh n) (map snd todo) + loop table_count + snd <$> + (forwardPut bh (const $ readFastMutInt symtab_next >>= put_ bh) $ + loop 0) + +getGenericSymbolTable :: forall a. (ReadBinHandle -> IO a) -> ReadBinHandle -> IO (SymbolTable a) +getGenericSymbolTable deserialiser bh = do + sz <- forwardGet bh (get bh) :: IO Int + mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int a) + -- Using lazyPut/lazyGet is quite space inefficient as each usage will allocate a large closure + -- (6 arguments-ish). + forM_ [0..(sz-1)] $ \i -> do + f <- lazyGet' Nothing (\_ -> deserialiser) bh + -- f <- deserialiser bh + writeArray mut_arr i f + unsafeFreeze mut_arr + +putGenericSymTab :: (Ord a, Binary a) => GenericSymbolTable a -> WriteBinHandle -> a -> IO () +putGenericSymTab GenericSymbolTable{ + gen_symtab_map = symtab_map_ref, + gen_symtab_next = symtab_next } + bh val = do + symtab_map <- readIORef symtab_map_ref + case Map.lookup val symtab_map of + Just off -> put_ bh (fromIntegral off :: Word32) + Nothing -> do + off <- readFastMutInt symtab_next + writeFastMutInt symtab_next (off+1) + writeIORef symtab_map_ref + $! Map.insert val off symtab_map + put_ bh (fromIntegral off :: Word32) + +getGenericSymtab :: Binary a => SymbolTable a -> ReadBinHandle -> IO a +getGenericSymtab symtab bh = do + i :: Word32 <- get bh + return $! symtab ! fromIntegral i + --------------------------------------------------------- -- The Dictionary --------------------------------------------------------- ===================================== compiler/Language/Haskell/Syntax/Type.hs ===================================== @@ -78,6 +78,7 @@ import Data.Eq import Data.Bool import Data.Char import Prelude (Integer, length) +import Data.Ord (Ord) {- ************************************************************************ @@ -91,7 +92,7 @@ import Prelude (Integer, length) data PromotionFlag = NotPromoted | IsPromoted - deriving ( Eq, Data ) + deriving ( Eq, Data, Ord ) isPromoted :: PromotionFlag -> Bool isPromoted IsPromoted = True ===================================== compiler/Language/Haskell/Syntax/Type.hs-boot ===================================== @@ -2,6 +2,7 @@ module Language.Haskell.Syntax.Type where import Data.Bool import Data.Eq +import Data.Ord {- ************************************************************************ @@ -17,5 +18,6 @@ data PromotionFlag | IsPromoted instance Eq PromotionFlag +instance Ord PromotionFlag isPromoted :: PromotionFlag -> Bool ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit edf742131e272fc29c6d6eae549b0fe37eea11b9 +Subproject commit fc8a6e6bbf4156ba01f0721a6d61d0daec36074d View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/043ed148bb082b93884dd0fac361cafd90f83abf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/043ed148bb082b93884dd0fac361cafd90f83abf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 14:34:07 2024 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 05 Apr 2024 10:34:07 -0400 Subject: [Git][ghc/ghc][wip/andreask/fix_fallthrough] NCG: Fix a bug where we errounously removed a required jump instruction. Message-ID: <66100bdfe8c08_180afb1fe213459048@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/fix_fallthrough at Glasgow Haskell Compiler / GHC Commits: 421dcd85 by Andreas Klebinger at 2024-04-05T16:33:55+02:00 NCG: Fix a bug where we errounously removed a required jump instruction. Add a new method to the Instruction class to check if we can eliminate a jump in favour of fallthrough control flow. Fixes #24507 - - - - - 13 changed files: - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Instr.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PPC.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - + testsuite/tests/codeGen/should_run/T24507.hs - + testsuite/tests/codeGen/should_run/T24507.stdout - + testsuite/tests/codeGen/should_run/T24507_cmm.cmm Changes: ===================================== compiler/GHC/CmmToAsm/AArch64.hs ===================================== @@ -47,6 +47,7 @@ instance Instruction AArch64.Instr where patchRegsOfInstr = AArch64.patchRegsOfInstr isJumpishInstr = AArch64.isJumpishInstr jumpDestsOfInstr = AArch64.jumpDestsOfInstr + canFallthroughTo = AArch64.canFallthroughTo patchJumpInstr = AArch64.patchJumpInstr mkSpillInstr = AArch64.mkSpillInstr mkLoadInstr = AArch64.mkLoadInstr ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -311,6 +311,12 @@ jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]] jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]] jumpDestsOfInstr _ = [] +canFallthroughTo :: Instr -> BlockId -> Bool +canFallthroughTo (ANN _ i) bid = canFallthroughTo i bid +canFallthroughTo (J (TBlock target)) bid = bid == target +canFallthroughTo (B (TBlock target)) bid = bid == target +canFallthroughTo _ _ = False + -- | Change the destination of this jump instruction. -- Used in the linear allocator when adding fixup blocks for join -- points. ===================================== compiler/GHC/CmmToAsm/BlockLayout.hs ===================================== @@ -771,10 +771,9 @@ dropJumps :: forall a i. Instruction i => LabelMap a -> [GenBasicBlock i] dropJumps _ [] = [] dropJumps info (BasicBlock lbl ins:todo) | Just ins <- nonEmpty ins --This can happen because of shortcutting - , [dest] <- jumpDestsOfInstr (NE.last ins) , BasicBlock nextLbl _ : _ <- todo - , not (mapMember dest info) - , nextLbl == dest + , canFallthroughTo (NE.last ins) nextLbl + , not (mapMember nextLbl info) = BasicBlock lbl (NE.init ins) : dropJumps info todo | otherwise = BasicBlock lbl ins : dropJumps info todo ===================================== compiler/GHC/CmmToAsm/Instr.hs ===================================== @@ -71,11 +71,17 @@ class Instruction instr where :: instr -> Bool - -- | Give the possible destinations of this jump instruction. + -- | Give the possible *local block* destinations of this jump instruction. -- Must be defined for all jumpish instructions. jumpDestsOfInstr :: instr -> [BlockId] + -- | Check if the instr always transfers control flow + -- to the given block. Used by code layout to eliminate + -- jumps that can be replaced by fall through. + canFallthroughTo + :: instr -> BlockId -> Bool + -- | Change the destination of this jump instruction. -- Used in the linear allocator when adding fixup blocks for join ===================================== compiler/GHC/CmmToAsm/Monad.hs ===================================== @@ -78,8 +78,15 @@ data NcgImpl statics instr jumpDest = NcgImpl { cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl statics instr], generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr), getJumpDestBlockId :: jumpDest -> Maybe BlockId, + -- | Does this jump always jump to a single destination and is shortcutable? + -- + -- We use this to determine shortcutable instructions - See Note [What is shortcutting] + -- Note that if we return a destination here we *most* support the relevant shortcutting in + -- shortcutStatics for jump tables and shortcutJump for the instructions itself. canShortcut :: instr -> Maybe jumpDest, + -- | Replace references to blockIds with other destinations - used to update jump tables. shortcutStatics :: (BlockId -> Maybe jumpDest) -> statics -> statics, + -- | Change the jump destination(s) of an instruction. shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr, -- | 'Module' is only for printing internal labels. See Note [Internal proc -- labels] in CLabel. @@ -105,6 +112,25 @@ data NcgImpl statics instr jumpDest = NcgImpl { -- when possible. } +{- Note [supporting shortcutting] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For the concept of shortcutting see Note [What is shortcutting]. + +In order to support shortcutting across multiple backends uniformly we +use canShortcut, shortcutStatics and shortcutJump. + +canShortcut tells us if the backend support shortcutting of a instruction +and if so what destination we should retarget instruction to instead. + +shortcutStatics exists to allow us to update jump destinations in jump tables. + +shortcutJump updates the instructions itself. + +A backend can opt out of those by always returning Nothing for canShortcut +and implementing shortcutStatics/shortcutJump as \_ x -> x + +-} + {- Note [pprNatCmmDeclS and pprNatCmmDeclH] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Each NcgImpl provides two implementations of its CmmDecl printer, pprNatCmmDeclS ===================================== compiler/GHC/CmmToAsm/PPC.hs ===================================== @@ -46,6 +46,7 @@ instance Instruction PPC.Instr where patchRegsOfInstr = PPC.patchRegsOfInstr isJumpishInstr = PPC.isJumpishInstr jumpDestsOfInstr = PPC.jumpDestsOfInstr + canFallthroughTo = PPC.canFallthroughTo patchJumpInstr = PPC.patchJumpInstr mkSpillInstr = PPC.mkSpillInstr mkLoadInstr = PPC.mkLoadInstr ===================================== compiler/GHC/CmmToAsm/PPC/Instr.hs ===================================== @@ -22,6 +22,7 @@ module GHC.CmmToAsm.PPC.Instr , patchJumpInstr , patchRegsOfInstr , jumpDestsOfInstr + , canFallthroughTo , takeRegRegMoveInstr , takeDeltaInstr , mkRegRegMoveInstr @@ -509,6 +510,13 @@ isJumpishInstr instr JMP{} -> True _ -> False +canFallthroughTo :: Instr -> BlockId -> Bool +canFallthroughTo instr bid + = case instr of + BCC _ target _ -> target == bid + BCCFAR _ target _ -> target == bid + _ -> False + -- | Checks whether this instruction is a jump/branch instruction. -- One that can change the flow of control in a way that the ===================================== compiler/GHC/CmmToAsm/Reg/Liveness.hs ===================================== @@ -126,6 +126,11 @@ instance Instruction instr => Instruction (InstrSR instr) where Instr instr -> isJumpishInstr instr _ -> False + jumpDestsOfInstr i + = case i of + Instr instr -> canFallthroughTo instr + _ -> [] + jumpDestsOfInstr i = case i of Instr instr -> jumpDestsOfInstr instr ===================================== compiler/GHC/CmmToAsm/X86.hs ===================================== @@ -51,6 +51,7 @@ instance Instruction X86.Instr where patchRegsOfInstr = X86.patchRegsOfInstr isJumpishInstr = X86.isJumpishInstr jumpDestsOfInstr = X86.jumpDestsOfInstr + canFallthroughTo = X86.canFallthroughTo patchJumpInstr = X86.patchJumpInstr mkSpillInstr = X86.mkSpillInstr mkLoadInstr = X86.mkLoadInstr ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -31,6 +31,7 @@ module GHC.CmmToAsm.X86.Instr , mkSpillInstr , mkRegRegMoveInstr , jumpDestsOfInstr + , canFallthroughTo , patchRegsOfInstr , patchJumpInstr , isMetaInstr @@ -669,6 +670,16 @@ isJumpishInstr instr CALL{} -> True _ -> False +canFallthroughTo :: Instr -> BlockId -> Bool +canFallthroughTo insn bid + = case insn of + JXX _ target -> bid == target + JMP_TBL _ targets _ _ -> all isTargetBid targets + where + isTargetBid target = case target of + Nothing -> True + Just (DestBlockId target) -> target == bid + _ -> False jumpDestsOfInstr :: Instr ===================================== testsuite/tests/codeGen/should_run/T24507.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Main where + +import GHC.Exts + +foreign import prim "foo" foo :: Int# -> Int# + +main = do + + let f x = case x of I# x' -> case foo x' of x -> print (I# x) + mapM_ f [1..7] \ No newline at end of file ===================================== testsuite/tests/codeGen/should_run/T24507.stdout ===================================== @@ -0,0 +1,7 @@ +1 +2 +2 +2 +2 +2 +2 ===================================== testsuite/tests/codeGen/should_run/T24507_cmm.cmm ===================================== @@ -0,0 +1,35 @@ +#include "Cmm.h" + +bar() { + return (2); +} + +foo(W_ x) { + + switch(x) { + case 1: goto a; + case 2: goto b; + case 3: goto c; + case 4: goto d; + case 5: goto e; + case 6: goto f; + case 7: goto g; + } + return (1); + + a: + return (1); + b: + jump bar(); + c: + jump bar(); + d: + jump bar(); + e: + jump bar(); + f: + jump bar(); + g: + jump bar(); + +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/421dcd85b8425707eabb2300136cc143f78868f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/421dcd85b8425707eabb2300136cc143f78868f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 14:37:16 2024 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 05 Apr 2024 10:37:16 -0400 Subject: [Git][ghc/ghc][wip/andreask/fix_fallthrough] NCG: Fix a bug where we errounously removed a required jump instruction. Message-ID: <66100c9c3b981_180afb20ea748608fb@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/fix_fallthrough at Glasgow Haskell Compiler / GHC Commits: 39a08d71 by Andreas Klebinger at 2024-04-05T16:37:02+02:00 NCG: Fix a bug where we errounously removed a required jump instruction. Add a new method to the Instruction class to check if we can eliminate a jump in favour of fallthrough control flow. Fixes #24507 - - - - - 13 changed files: - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Instr.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PPC.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - + testsuite/tests/codeGen/should_run/T24507.hs - + testsuite/tests/codeGen/should_run/T24507.stdout - + testsuite/tests/codeGen/should_run/T24507_cmm.cmm Changes: ===================================== compiler/GHC/CmmToAsm/AArch64.hs ===================================== @@ -47,6 +47,7 @@ instance Instruction AArch64.Instr where patchRegsOfInstr = AArch64.patchRegsOfInstr isJumpishInstr = AArch64.isJumpishInstr jumpDestsOfInstr = AArch64.jumpDestsOfInstr + canFallthroughTo = AArch64.canFallthroughTo patchJumpInstr = AArch64.patchJumpInstr mkSpillInstr = AArch64.mkSpillInstr mkLoadInstr = AArch64.mkLoadInstr ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -311,6 +311,12 @@ jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]] jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]] jumpDestsOfInstr _ = [] +canFallthroughTo :: Instr -> BlockId -> Bool +canFallthroughTo (ANN _ i) bid = canFallthroughTo i bid +canFallthroughTo (J (TBlock target)) bid = bid == target +canFallthroughTo (B (TBlock target)) bid = bid == target +canFallthroughTo _ _ = False + -- | Change the destination of this jump instruction. -- Used in the linear allocator when adding fixup blocks for join -- points. ===================================== compiler/GHC/CmmToAsm/BlockLayout.hs ===================================== @@ -771,10 +771,9 @@ dropJumps :: forall a i. Instruction i => LabelMap a -> [GenBasicBlock i] dropJumps _ [] = [] dropJumps info (BasicBlock lbl ins:todo) | Just ins <- nonEmpty ins --This can happen because of shortcutting - , [dest] <- jumpDestsOfInstr (NE.last ins) , BasicBlock nextLbl _ : _ <- todo - , not (mapMember dest info) - , nextLbl == dest + , canFallthroughTo (NE.last ins) nextLbl + , not (mapMember nextLbl info) = BasicBlock lbl (NE.init ins) : dropJumps info todo | otherwise = BasicBlock lbl ins : dropJumps info todo ===================================== compiler/GHC/CmmToAsm/Instr.hs ===================================== @@ -71,11 +71,17 @@ class Instruction instr where :: instr -> Bool - -- | Give the possible destinations of this jump instruction. + -- | Give the possible *local block* destinations of this jump instruction. -- Must be defined for all jumpish instructions. jumpDestsOfInstr :: instr -> [BlockId] + -- | Check if the instr always transfers control flow + -- to the given block. Used by code layout to eliminate + -- jumps that can be replaced by fall through. + canFallthroughTo + :: instr -> BlockId -> Bool + -- | Change the destination of this jump instruction. -- Used in the linear allocator when adding fixup blocks for join ===================================== compiler/GHC/CmmToAsm/Monad.hs ===================================== @@ -78,8 +78,15 @@ data NcgImpl statics instr jumpDest = NcgImpl { cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl statics instr], generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr), getJumpDestBlockId :: jumpDest -> Maybe BlockId, + -- | Does this jump always jump to a single destination and is shortcutable? + -- + -- We use this to determine shortcutable instructions - See Note [What is shortcutting] + -- Note that if we return a destination here we *most* support the relevant shortcutting in + -- shortcutStatics for jump tables and shortcutJump for the instructions itself. canShortcut :: instr -> Maybe jumpDest, + -- | Replace references to blockIds with other destinations - used to update jump tables. shortcutStatics :: (BlockId -> Maybe jumpDest) -> statics -> statics, + -- | Change the jump destination(s) of an instruction. shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr, -- | 'Module' is only for printing internal labels. See Note [Internal proc -- labels] in CLabel. @@ -105,6 +112,25 @@ data NcgImpl statics instr jumpDest = NcgImpl { -- when possible. } +{- Note [supporting shortcutting] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For the concept of shortcutting see Note [What is shortcutting]. + +In order to support shortcutting across multiple backends uniformly we +use canShortcut, shortcutStatics and shortcutJump. + +canShortcut tells us if the backend support shortcutting of a instruction +and if so what destination we should retarget instruction to instead. + +shortcutStatics exists to allow us to update jump destinations in jump tables. + +shortcutJump updates the instructions itself. + +A backend can opt out of those by always returning Nothing for canShortcut +and implementing shortcutStatics/shortcutJump as \_ x -> x + +-} + {- Note [pprNatCmmDeclS and pprNatCmmDeclH] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Each NcgImpl provides two implementations of its CmmDecl printer, pprNatCmmDeclS ===================================== compiler/GHC/CmmToAsm/PPC.hs ===================================== @@ -46,6 +46,7 @@ instance Instruction PPC.Instr where patchRegsOfInstr = PPC.patchRegsOfInstr isJumpishInstr = PPC.isJumpishInstr jumpDestsOfInstr = PPC.jumpDestsOfInstr + canFallthroughTo = PPC.canFallthroughTo patchJumpInstr = PPC.patchJumpInstr mkSpillInstr = PPC.mkSpillInstr mkLoadInstr = PPC.mkLoadInstr ===================================== compiler/GHC/CmmToAsm/PPC/Instr.hs ===================================== @@ -22,6 +22,7 @@ module GHC.CmmToAsm.PPC.Instr , patchJumpInstr , patchRegsOfInstr , jumpDestsOfInstr + , canFallthroughTo , takeRegRegMoveInstr , takeDeltaInstr , mkRegRegMoveInstr @@ -509,6 +510,13 @@ isJumpishInstr instr JMP{} -> True _ -> False +canFallthroughTo :: Instr -> BlockId -> Bool +canFallthroughTo instr bid + = case instr of + BCC _ target _ -> target == bid + BCCFAR _ target _ -> target == bid + _ -> False + -- | Checks whether this instruction is a jump/branch instruction. -- One that can change the flow of control in a way that the ===================================== compiler/GHC/CmmToAsm/Reg/Liveness.hs ===================================== @@ -126,6 +126,11 @@ instance Instruction instr => Instruction (InstrSR instr) where Instr instr -> isJumpishInstr instr _ -> False + canFallthroughTo i bid + = case i of + Instr instr -> canFallthroughTo instr bid + _ -> False + jumpDestsOfInstr i = case i of Instr instr -> jumpDestsOfInstr instr ===================================== compiler/GHC/CmmToAsm/X86.hs ===================================== @@ -51,6 +51,7 @@ instance Instruction X86.Instr where patchRegsOfInstr = X86.patchRegsOfInstr isJumpishInstr = X86.isJumpishInstr jumpDestsOfInstr = X86.jumpDestsOfInstr + canFallthroughTo = X86.canFallthroughTo patchJumpInstr = X86.patchJumpInstr mkSpillInstr = X86.mkSpillInstr mkLoadInstr = X86.mkLoadInstr ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -31,6 +31,7 @@ module GHC.CmmToAsm.X86.Instr , mkSpillInstr , mkRegRegMoveInstr , jumpDestsOfInstr + , canFallthroughTo , patchRegsOfInstr , patchJumpInstr , isMetaInstr @@ -669,6 +670,16 @@ isJumpishInstr instr CALL{} -> True _ -> False +canFallthroughTo :: Instr -> BlockId -> Bool +canFallthroughTo insn bid + = case insn of + JXX _ target -> bid == target + JMP_TBL _ targets _ _ -> all isTargetBid targets + where + isTargetBid target = case target of + Nothing -> True + Just (DestBlockId target) -> target == bid + _ -> False jumpDestsOfInstr :: Instr ===================================== testsuite/tests/codeGen/should_run/T24507.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Main where + +import GHC.Exts + +foreign import prim "foo" foo :: Int# -> Int# + +main = do + + let f x = case x of I# x' -> case foo x' of x -> print (I# x) + mapM_ f [1..7] \ No newline at end of file ===================================== testsuite/tests/codeGen/should_run/T24507.stdout ===================================== @@ -0,0 +1,7 @@ +1 +2 +2 +2 +2 +2 +2 ===================================== testsuite/tests/codeGen/should_run/T24507_cmm.cmm ===================================== @@ -0,0 +1,35 @@ +#include "Cmm.h" + +bar() { + return (2); +} + +foo(W_ x) { + + switch(x) { + case 1: goto a; + case 2: goto b; + case 3: goto c; + case 4: goto d; + case 5: goto e; + case 6: goto f; + case 7: goto g; + } + return (1); + + a: + return (1); + b: + jump bar(); + c: + jump bar(); + d: + jump bar(); + e: + jump bar(); + f: + jump bar(); + g: + jump bar(); + +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39a08d7159a369755e6c3978805de2e0819fd0bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39a08d7159a369755e6c3978805de2e0819fd0bd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 14:42:28 2024 From: gitlab at gitlab.haskell.org (Mikolaj Konarski (@Mikolaj)) Date: Fri, 05 Apr 2024 10:42:28 -0400 Subject: [Git][ghc/ghc][wip/T23923-mikolaj-take-2] Touch up the new Note Message-ID: <66100dd4c8a4e_180afb2299cb06115e@gitlab.mail> Mikolaj Konarski pushed to branch wip/T23923-mikolaj-take-2 at Glasgow Haskell Compiler / GHC Commits: 6eedc476 by Mikolaj Konarski at 2024-04-05T16:01:14+02:00 Touch up the new Note - - - - - 1 changed file: - compiler/GHC/Core/TyCo/Rep.hs Changes: ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1796,7 +1796,6 @@ In particular, given | tv `elemVarSet` acc = acc | otherwise = acc `extendVarSet` tv - we want to end up with fvs ty = go emptyVarSet ty emptyVarSet where @@ -1832,9 +1831,9 @@ Note [Use explicit recursion in foldTyCo] In foldTyCo you'll see things like: go_tys _ [] = mempty go_tys env (t:ts) = go_ty env t `mappend` go_tys env ts -where we use /explicit recursion/. You might wonder about using foldr instead: +where we use /explicit recursion/. You might wonder about using foldl instead: go_tys env = foldl (\t acc -> go_ty env t `mappend` acc) mempty -Or maybe or foldl', or foldr. +Or maybe foldl', or foldr. But don't do that for two reasons (see #24591) @@ -1848,7 +1847,7 @@ But don't do that for two reasons (see #24591) But in the foldl form that is /much/ less obvious, and the strictness analyser fails utterly. Result: lots and lots of thunks get built. In - !12037, Mikolaj found that GHC allocated allocated /six times/ as much heap + !12037, Mikolaj found that GHC allocated /six times/ as much heap on test perf/compiler/T9198 as a result of this single problem! * Second, while I think that using `foldr` would be fine (simple experiments in View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6eedc47691c7078c731a3e51db92b9c68bf35b3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6eedc47691c7078c731a3e51db92b9c68bf35b3a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 15:35:28 2024 From: gitlab at gitlab.haskell.org (Hannes Siebenhandl (@fendor)) Date: Fri, 05 Apr 2024 11:35:28 -0400 Subject: [Git][ghc/ghc][wip/fendor/ifacetype-deduplication] 60 commits: rts: Fix TSAN_ENABLED CPP guard Message-ID: <66101a407eb99_2ba06f5f6e14674c2@gitlab.mail> Hannes Siebenhandl pushed to branch wip/fendor/ifacetype-deduplication at Glasgow Haskell Compiler / GHC Commits: c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 0fde229f by Ben Gamari at 2024-04-04T07:04:58-04:00 testsuite: Introduce template-haskell-exports test - - - - - 0c4a9686 by Luite Stegeman at 2024-04-04T07:05:39-04:00 Update correct counter in bumpTickyAllocd - - - - - 5f085d3a by Fendor at 2024-04-04T14:47:33-04:00 Replace `SizedSeq` with `FlatBag` for flattened structure LinkedLists are notoriously memory ineffiecient when all we do is traversing a structure. As 'UnlinkedBCO' has been identified as a data structure that impacts the overall memory usage of GHCi sessions, we avoid linked lists and prefer flattened structure for storing. We introduce a new memory efficient representation of sequential elements that has special support for the cases: * Empty * Singleton * Tuple Elements This improves sharing in the 'Empty' case and avoids the overhead of 'Array' until its constant overhead is justified. - - - - - 82cfe10c by Fendor at 2024-04-04T14:47:33-04:00 Compact FlatBag array representation `Array` contains three additional `Word`'s we do not need in `FlatBag`. Move `FlatBag` to `SmallArray`. Expand the API of SmallArray by `sizeofSmallArray` and add common traversal functions, such as `mapSmallArray` and `foldMapSmallArray`. Additionally, allow users to force the elements of a `SmallArray` via `rnfSmallArray`. - - - - - 36a75b80 by Andrei Borzenkov at 2024-04-04T14:48:10-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 28009fbc by Matthew Pickering at 2024-04-04T14:48:46-04:00 Fix off by one error in seekBinNoExpand and seekBin - - - - - 9b9e031b by Ben Gamari at 2024-04-04T21:30:08-04:00 compiler: Allow more types in GHCForeignImportPrim For many, many years `GHCForeignImportPrim` has suffered from the rather restrictive limitation of not allowing any non-trivial types in arguments or results. This limitation was justified by the code generator allegely barfing in the presence of such types. However, this restriction appears to originate well before the NCG rewrite and the new NCG does not appear to have any trouble with such types (see the added `T24598` test). Lift this restriction. Fixes #24598. - - - - - 1324b862 by Alan Zimmerman at 2024-04-04T21:30:44-04:00 EPA: Use EpaLocation not SrcSpan in ForeignDecls This allows us to update them for makeDeltaAst in ghc-exactprint - - - - - ed3fb50d by Fendor at 2024-04-05T13:14:59+01:00 Refactor the Binary serialisation interface The end goal is to dynamically add deduplication tables for `ModIface` interface serialisation. We identify two main points of interest that make this difficult: 1. UserData hardcodes what `Binary` instances can have deduplication tables. Moreover, it heavily uses partial functions. 2. GHC.Iface.Binary hardcodes the deduplication tables for 'Name' and 'FastString', making it difficult to add more deduplication. Instead of having a single `UserData` record with fields for all the types that can have deduplication tables, we allow to provide custom serialisers for any `Typeable`. These are wrapped in existentials and stored in a `Map` indexed by their respective `TypeRep`. The `Binary` instance of the type to deduplicate still needs to explicitly look up the decoder via `findUserDataReader` and `findUserDataWriter`, which is no worse than the status-quo. `Map` was chosen as microbenchmarks indicate it is the fastest for a small number of keys (< 10). To generalise the deduplication table serialisation mechanism, we introduce the types `ReaderTable` and `WriterTable` which provide a simple interface that is sufficient to implement a general purpose deduplication mechanism for `writeBinIface` and `readBinIface`. This allows us to provide a list of deduplication tables for serialisation that can be extended more easily, for example for `IfaceTyCon`, see the issue https://gitlab.haskell.org/ghc/ghc/-/issues/24540 for more motivation. In addition to ths refactoring, we split `UserData` into `ReaderUserData` and `WriterUserData`, to avoid partial functions. Bump haddock submodule to accomodate for `UserData` split. ------------------------- Metric Increase: T21839c ------------------------- - - - - - adf68fba by Fendor at 2024-04-05T15:13:12+02:00 Split `BinHandle` into `ReadBinHandle` and `WriteBinHandle` A `BinHandle` contains too much information for reading data. For example, it needs to keep a `FastMutInt` and a `IORef BinData`, when the non-mutable variants would suffice. Additionally, this change has the benefit that anyone can immediately tell whether the `BinHandle` is used for reading or writing. Bump haddock submodule BinHandle split. - - - - - 87897928 by Matthew Pickering at 2024-04-05T17:20:36+02:00 Add deduplication table for `IfaceType` The type `IfaceType` is a highly redundant, tree-like data structure. While benchmarking, we realised that the high redundancy of `IfaceType` causes high memory consumption in GHCi sessions. We fix this by adding a deduplication table to the serialisation of `ModIface`, similar to how we deduplicate `Name`s and `FastString`s. When reading the interface file back, the table allows us to automatically share identical values of `IfaceType`. This deduplication has the beneficial side effect to additionally reduce the size of the on-disk interface files tremendously. On the agda code base, we reduce the size from 28 MB to 16 MB. When `-fwrite-simplified-core` is enabled, we reduce the size from 112 MB to 22 MB. We have to add an `Ord` instance to `IfaceType` in order to store it efficiently for look up operations. This is mostly straightforward, we change occurrences of `FastString` with `LexicalFastString` and add a newtype definition for `IfLclName = LexicalFastString`. Bump haddock submodule for `IfLclName` newtype changes. - - - - - 19 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/043ed148bb082b93884dd0fac361cafd90f83abf...87897928c0e0e7f44ddfac6633ef1301a5d2778f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/043ed148bb082b93884dd0fac361cafd90f83abf...87897928c0e0e7f44ddfac6633ef1301a5d2778f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 16:24:14 2024 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 05 Apr 2024 12:24:14 -0400 Subject: [Git][ghc/ghc][wip/T20749] 478 commits: Make forall a keyword (#23719) Message-ID: <661025aed6bf9_2ba06fba6c9c733dc@gitlab.mail> Sebastian Graf pushed to branch wip/T20749 at Glasgow Haskell Compiler / GHC Commits: d9e4c597 by Vladislav Zavialov at 2023-12-11T04:19:34-05:00 Make forall a keyword (#23719) Before this change, GHC used to accept `forall` as a term-level identifier: -- from constraints-0.13 forall :: forall p. (forall a. Dict (p a)) -> Dict (Forall p) forall d = ... Now it is a parse error. The -Wforall-identifier warning has served its purpose and is now a deprecated no-op. - - - - - 58d56644 by Zubin Duggal at 2023-12-11T04:20:10-05:00 driver: Ensure we actually clear the interactive context before reloading Previously we called discardIC, but immediately after set the session back to an old HscEnv that still contained the IC Partially addresses #24107 Fixes #23405 - - - - - 8e5745a0 by Zubin Duggal at 2023-12-11T04:20:10-05:00 driver: Ensure we force the lookup of old build artifacts before returning the build plan This prevents us from retaining all previous build artifacts in memory until a recompile finishes, instead only retaining the exact artifacts we need. Fixes #24118 - - - - - 105c370c by Zubin Duggal at 2023-12-11T04:20:10-05:00 testsuite: add test for #24118 and #24107 MultiLayerModulesDefsGhci was not able to catch the leak because it uses :l which discards the previous environment. Using :r catches both of these leaks - - - - - e822ff88 by Zubin Duggal at 2023-12-11T04:20:10-05:00 compiler: Add some strictness annotations to ImportSpec and related constructors This prevents us from retaining entire HscEnvs. Force these ImportSpecs when forcing the GlobalRdrEltX Adds an NFData instance for Bag Fixes #24107 - - - - - 522c12a4 by Zubin Duggal at 2023-12-11T04:20:10-05:00 compiler: Force IfGlobalRdrEnv in NFData instance. - - - - - 188b280d by Arnaud Spiwack at 2023-12-11T15:33:31+01:00 LinearTypes => MonoLocalBinds - - - - - 8e0446df by Arnaud Spiwack at 2023-12-11T15:44:28+01:00 Linear let and where bindings For expediency, the initial implementation of linear types in GHC made it so that let and where binders would always be considered unrestricted. This was rather unpleasant, and probably a big obstacle to adoption. At any rate, this was not how the proposal was designed. This patch fixes this infelicity. It was surprisingly difficult to build, which explains, in part, why it took so long to materialise. As of this patch, let or where bindings marked with %1 will be linear (respectively %p for an arbitrary multiplicity p). Unmarked let will infer their multiplicity. Here is a prototypical example of program that used to be rejected and is accepted with this patch: ```haskell f :: A %1 -> B g :: B %1 -> C h :: A %1 -> C h x = g y where y = f x ``` Exceptions: - Recursive let are unrestricted, as there isn't a clear semantics of what a linear recursive binding would be. - Destructive lets with lazy bindings are unrestricted, as their desugaring isn't linear (see also #23461). - (Strict) destructive lets with inferred polymorphic type are unrestricted. Because the desugaring isn't linear (See #18461 down-thread). Closes #18461 and #18739 Co-authored-by: @jackohughes - - - - - effa7e2d by Matthew Craven at 2023-12-12T04:37:20-05:00 Introduce `dataToTagSmall#` primop (closes #21710) ...and use it to generate slightly better code when dataToTag# is used at a "small data type" where there is no need to mess with "is_too_big_tag" or potentially look at an info table. Metric Decrease: T18304 - - - - - 35c7aef6 by Matthew Craven at 2023-12-12T04:37:20-05:00 Fix formatting of Note [alg-alt heap check] - - - - - 7397c784 by Oleg Grenrus at 2023-12-12T04:37:56-05:00 Allow untyped brackets in typed splices and vice versa. Resolves #24190 Apparently the check was essentially always (as far as I can trace back: d0d47ba76f8f0501cf3c4966bc83966ab38cac27), and while it does catch some mismatches, the type-checker will catch them too. OTOH, it prevents writing completely reasonable programs. - - - - - a3ee3b99 by Moritz Angermann at 2023-12-12T19:50:58-05:00 Drop hard Xcode dependency XCODE_VERSION calls out to `xcodebuild`, which is only available when having `Xcode` installed. The CommandLineTools are not sufficient. To install Xcode, you must have an apple id to download the Xcode.xip from apple. We do not use xcodebuild anywhere in our build explicilty. At best it appears to be a proxy for checking the linker or the compiler. These should rather be done with ``` xcrun ld -version ``` or similar, and not by proxy through Xcode. The CLR should be sufficient for building software on macOS. - - - - - 1c9496e0 by Vladislav Zavialov at 2023-12-12T19:51:34-05:00 docs: update information on RequiredTypeArguments Update the User's Guide and Release Notes to account for the recent progress in the implementation of RequiredTypeArguments. - - - - - d0b17576 by Ben Gamari at 2023-12-13T06:33:37-05:00 rts/eventlog: Fix off-by-one in assertion Previously we failed to account for the NULL terminator `postString` asserted that there is enough room in the buffer for the string. - - - - - a10f9b9b by Ben Gamari at 2023-12-13T06:33:37-05:00 rts/eventlog: Honor result of ensureRoomForVariableEvent is Previously we would keep plugging along, even if isn't enough room for the event. - - - - - 0e0f41c0 by Ben Gamari at 2023-12-13T06:33:37-05:00 rts/eventlog: Avoid truncating event sizes Previously ensureRoomForVariableEvent would truncate the desired size to 16-bits, resulting in #24197. Fixes #24197. - - - - - 64e724c8 by Artin Ghasivand at 2023-12-13T06:34:20-05:00 Remove the "Derived Constraint" argument of TcPluginSolver, docs - - - - - fe6d97dd by Vladislav Zavialov at 2023-12-13T06:34:56-05:00 EPA: Move tokens into GhcPs extension fields (#23447) Summary of changes * Remove Language.Haskell.Syntax.Concrete * Move all tokens into GhcPs extension fields (LHsToken -> EpToken) * Create new TTG extension fields as needed * Drop the MultAnn wrapper Updates the haddock submodule. Co-authored-by: Alan Zimmerman <alan.zimm at gmail.com> - - - - - 8106e695 by Zubin Duggal at 2023-12-13T06:35:34-05:00 testsuite: use copy_files in T23405 This prevents the tree from being dirtied when the file is modified. - - - - - ed0e4099 by Bryan Richter at 2023-12-14T04:30:53-05:00 Document ghc package's PVP-noncompliance This changes nothing, it just makes the status quo explicit. - - - - - 8bef8d9f by Luite Stegeman at 2023-12-14T04:31:33-05:00 JS: Mark spurious CI failures js_fragile(24259) This marks the spurious test failures on the JS platform as js_fragile(24259), so we don't hold up merge requests while fixing the underlying issues. See #24259 - - - - - 1c79526a by Finley McIlwaine at 2023-12-15T12:24:40-08:00 Late plugins - - - - - 000c3302 by Finley McIlwaine at 2023-12-15T12:24:40-08:00 withTiming on LateCCs and late plugins - - - - - be4551ac by Finley McIlwaine at 2023-12-15T12:24:40-08:00 add test for late plugins - - - - - 7c29da9f by Finley McIlwaine at 2023-12-15T12:24:40-08:00 Document late plugins - - - - - 9a52ae46 by Ben Gamari at 2023-12-20T07:07:26-05: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. - - - - - f4b53538 by Vladislav Zavialov at 2023-12-20T07:08:02-05:00 docs: Fix link to 051-ghc-base-libraries.rst The proposal is no longer available at the previous URL. - - - - - f7e21fab by Matthew Pickering at 2023-12-21T14:57:40+00:00 hadrian: Build all executables in bin/ folder In the end the bindist creation logic copies them all into the bin folder. There is no benefit to building a specific few binaries in the lib/bin folder anymore. This also removes the ad-hoc logic to copy the touchy and unlit executables from stage0 into stage1. It takes <1s to build so we might as well just build it. - - - - - 0038d052 by Zubin Duggal at 2023-12-22T23:28:00-05:00 testsuite: mark jspace as fragile on i386. This test has been flaky for some time and has been failing consistently on i386-linux since 8e0446df landed. See #24261 - - - - - dfd670a0 by Ben Bellick at 2023-12-24T10:10:31-05:00 Deprecate -ddump-json and introduce -fdiagnostics-as-json Addresses #19278 This commit deprecates the underspecified -ddump-json flag and introduces a newer, well-specified flag -fdiagnostics-as-json. Also included is a JSON schema as part of the documentation. The -ddump-json flag will be slated for removal shortly after this merge. - - - - - 609e6225 by Ben Bellick at 2023-12-24T10:10:31-05:00 Deprecate -ddump-json and introduce -fdiagnostics-as-json Addresses #19278 This commit deprecates the underspecified -ddump-json flag and introduces a newer, well-specified flag -fdiagnostics-as-json. Also included is a JSON schema as part of the documentation. The -ddump-json flag will be slated for removal shortly after this merge. - - - - - 865513b2 by Ömer Sinan Ağacan at 2023-12-24T10:11:13-05:00 Fix BNF in user manual 6.6.8.2: formal syntax for instance declarations - - - - - c247b6be by Zubin Duggal at 2023-12-25T16:01:23-05:00 docs: document permissibility of -XOverloadedLabels (#24249) Document the permissibility introduced by https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst - - - - - e5b7eb59 by Ömer Sinan Ağacan at 2023-12-25T16:02:03-05:00 Fix a code block syntax in user manual sec. 6.8.8.6 - - - - - 2db11c08 by Ben Gamari at 2023-12-29T15:35:48-05:00 genSym: Reimplement via CAS on 32-bit platforms Previously the remaining use of the C implementation on 32-bit platforms resulted in a subtle bug, #24261. This was due to the C object (which used the RTS's `atomic_inc64` macro) being compiled without `-threaded` yet later being used in a threaded compiler. Side-step this issue by using the pure Haskell `genSym` implementation on all platforms. This required implementing `fetchAddWord64Addr#` in terms of CAS on 64-bit platforms. - - - - - 19328a8c by Xiaoyan Ren at 2023-12-29T15:36:30-05:00 Do not color the diagnostic code in error messages (#24172) - - - - - 685b467c by Krzysztof Gogolewski at 2023-12-29T15:37:06-05:00 Enforce that bindings of implicit parameters are lifted Fixes #24298 - - - - - bc4d67b7 by Matthew Craven at 2023-12-31T06:15:42-05:00 StgToCmm: Detect some no-op case-continuations ...and generate no code for them. Fixes #24264. - - - - - 5b603139 by Krzysztof Gogolewski at 2023-12-31T06:16:18-05:00 Revert "testsuite: mark jspace as fragile on i386." This reverts commit 0038d052c8c80b4b430bb2aa1c66d5280be1aa95. The atomicity bug should be fixed by !11802. - - - - - d55216ad by Krzysztof Gogolewski at 2024-01-01T12:05:49-05:00 Refactor: store [[PrimRep]] rather than [Type] in STG StgConApp stored a list of types. This list was used exclusively during unarisation of unboxed sums (mkUbxSum). However, this is at a wrong level of abstraction: STG shouldn't be concerned with Haskell types, only PrimReps. Update the code to store a [[PrimRep]]. Also, there's no point in storing this list when we're not dealing with an unboxed sum. - - - - - 8b340bc7 by Ömer Sinan Ağacan at 2024-01-01T12:06:29-05:00 Kind signatures docs: mention that they're allowed in newtypes - - - - - 989bf8e5 by Zubin Duggal at 2024-01-03T20:08:47-05:00 ci: Ensure we use the correct bindist name for the test artifact when generating release ghcup metadata Fixes #24268 - - - - - 89299a89 by Krzysztof Gogolewski at 2024-01-03T20:09:23-05:00 Refactor: remove calls to typePrimRepArgs The function typePrimRepArgs is just a thin wrapper around typePrimRep, adding a VoidRep if the list is empty. However, in StgToByteCode, we were discarding that VoidRep anyway, so there's no point in calling it. - - - - - c7be0c68 by mmzk1526 at 2024-01-03T20:10:07-05:00 Use "-V" for alex version check for better backward compatibility Fixes #24302. In recent versions of alex, "-v" is used for "--verbose" instead of "-version". - - - - - 67dbcc0a by Krzysztof Gogolewski at 2024-01-05T02:07:18-05:00 Fix VoidRep handling in ghci debugger 'go' inside extractSubTerms was giving a bad result given a VoidRep, attempting to round towards the next multiple of 0. I don't understand much about the debugger but the code should be better than it was. Fixes #24306 - - - - - 90ea574e by Krzysztof Gogolewski at 2024-01-05T02:07:54-05:00 VoidRep-related refactor * In GHC.StgToByteCode, replace bcIdPrimId with idPrimRep, bcIdArgRep with idArgRep, atomPrimRep with stgArgRep1. All of them were duplicates. * In GHC.Stg.Unarise, we were converting a PrimRep to a Type and back to PrimRep. Remove the calls to primRepToType and typePrimRep1 which cancel out. * In GHC.STG.Lint, GHC.StgToCmm, GHC.Types.RepType we were filtering out VoidRep from the result of typePrimRep. But typePrimRep never returns VoidRep - remove the filtering. - - - - - eaf72479 by brian at 2024-01-06T23:03:09-05:00 Add unaligned Addr# primops Implements CLC proposal #154: https://github.com/haskell/core-libraries-committee/issues/154 * add unaligned addr primops * add tests * accept tests * add documentation * fix js primops * uncomment in access ops * use Word64 in tests * apply suggestions * remove extra file * move docs * remove random options * use setByteArray# primop * better naming * update base-exports test * add base-exports for other architectures - - - - - d471d445 by Krzysztof Gogolewski at 2024-01-06T23:03:47-05:00 Remove VoidRep from PrimRep, introduce PrimOrVoidRep This introduces data PrimOrVoidRep = VoidRep | NVRep PrimRep changes typePrimRep1 to return PrimOrVoidRep, and adds a new function typePrimRepU to be used when the argument is definitely non-void. Details in Note [VoidRep] in GHC.Types.RepType. Fixes #19520 - - - - - 48720a07 by Matthew Craven at 2024-01-08T18:57:36-05:00 Apply Note [Sensitivity to unique increment] to LargeRecord - - - - - 9e2e180f by Sebastian Graf at 2024-01-08T18:58:13-05:00 Debugging: Add diffUFM for convenient diffing between UniqFMs - - - - - 948f3e35 by Sebastian Graf at 2024-01-08T18:58:13-05:00 Rename Opt_D_dump_stranal to Opt_D_dump_dmdanal ... and Opt_D_dump_str_signatures to Opt_D_dump_dmd_signatures - - - - - 4e217e3e by Sebastian Graf at 2024-01-08T18:58:13-05:00 Deprecate -ddump-stranal and -ddump-str-signatures ... and suggest -ddump-dmdanal and -ddump-dmd-signatures instead - - - - - 6c613c90 by Sebastian Graf at 2024-01-08T18:58:13-05:00 Move testsuite/tests/stranal to testsuite/tests/dmdanal A separate commit so that the rename is obvious to Git(Lab) - - - - - c929f02b by Sebastian Graf at 2024-01-08T18:58:13-05:00 CoreSubst: Stricten `substBndr` and `cloneBndr` Doing so reduced allocations of `cloneBndr` by about 25%. ``` T9233(normal) ghc/alloc 672,488,656 663,083,216 -1.4% GOOD T9675(optasm) ghc/alloc 423,029,256 415,812,200 -1.7% geo. mean -0.1% minimum -1.7% maximum +0.1% ``` Metric Decrease: T9233 - - - - - e3ca78f3 by Krzysztof Gogolewski at 2024-01-10T17:35:59-05:00 Deprecate -Wsemigroup This warning was used to prepare for Semigroup becoming a superclass of Monoid, and for (<>) being exported from Prelude. This happened in GHC 8.4 in 8ae263ceb3566 and feac0a3bc69fd3. The leftover logic for (<>) has been removed in GHC 9.8, 4d29ecdfcc79. Now the warning does nothing at all and can be deprecated. - - - - - 08d14925 by amesgen at 2024-01-10T17:36:42-05:00 WASM metadata: use correct GHC version - - - - - 7a808419 by Xiaoyan Ren at 2024-01-10T17:37:24-05:00 Allow SCC declarations in TH (#24081) - - - - - 28827c51 by Xiaoyan Ren at 2024-01-10T17:37:24-05:00 Fix prettyprinting of SCC pragmas - - - - - ae9cc1a8 by Matthew Craven at 2024-01-10T17:38:01-05:00 Fix loopification in the presence of void arguments This also removes Note [Void arguments in self-recursive tail calls], which was just misleading. It's important to count void args both in the function's arity and at the call site. Fixes #24295. - - - - - b718b145 by Zubin Duggal at 2024-01-10T17:38:36-05:00 testsuite: Teach testsuite driver about c++ sources - - - - - 09cb57ad by Zubin Duggal at 2024-01-10T17:38:36-05:00 driver: Set -DPROFILING when compiling C++ sources with profiling Earlier, we used to pass all preprocessor flags to the c++ compiler. This meant that -DPROFILING was passed to the c++ compiler because it was a part of C++ flags However, this was incorrect and the behaviour was changed in 8ff3134ed4aa323b0199ad683f72165e51a59ab6. See #21291. But that commit exposed this bug where -DPROFILING was no longer being passed when compiling c++ sources. The fix is to explicitly include -DPROFILING in `opt_cxx` when profiling is enabled to ensure we pass the correct options for the way to both C and C++ compilers Fixes #24286 - - - - - 2cf9dd96 by Zubin Duggal at 2024-01-10T17:38:36-05:00 testsuite: rename objcpp -> objcxx To avoid confusion with C Pre Processsor - - - - - af6932d6 by Simon Peyton Jones at 2024-01-10T17:39:12-05:00 Make TYPE and CONSTRAINT not-apart Issue #24279 showed up a bug in the logic in GHC.Core.Unify.unify_ty which is supposed to make TYPE and CONSTRAINT be not-apart. Easily fixed. - - - - - 4a39b5ff by Zubin Duggal at 2024-01-10T17:39:48-05:00 ci: Fix typo in mk_ghcup_metadata.py There was a missing colon in the fix to #24268 in 989bf8e53c08eb22de716901b914b3607bc8dd08 - - - - - 13503451 by Zubin Duggal at 2024-01-10T17:40:24-05:00 release-ci: remove release-x86_64-linux-deb11-release+boot_nonmoving_gc job There is no reason to have this release build or distribute this variation. This configuration is for testing purposes only. - - - - - afca46a4 by Sebastian Graf at 2024-01-10T17:41:00-05:00 Parser: Add a Note detailing why we need happy's `error` to implement layout - - - - - eaf8a06d by Krzysztof Gogolewski at 2024-01-11T00:43:17+01:00 Turn -Wtype-equality-out-of-scope on by default Also remove -Wnoncanonical-{monoid,monad}-instances from -Wcompat, since they are enabled by default. Refresh wcompat-warnings/ test with new -Wcompat warnings. Part of #24267 Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - 42bee5aa by Sebastian Graf at 2024-01-12T21:16:21-05:00 Arity: Require called *exactly once* for eta exp with -fpedantic-bottoms (#24296) In #24296, we had a program in which we eta expanded away an error despite the presence of `-fpedantic-bottoms`. This was caused by turning called *at least once* lambdas into one-shot lambdas, while with `-fpedantic-bottoms` it is only sound to eta expand over lambdas that are called *exactly* once. An example can be found in `Note [Combining arity type with demand info]`. Fixes #24296. - - - - - 7e95f738 by Andreas Klebinger at 2024-01-12T21:16:57-05:00 Aarch64: Enable -mfma by default. Fixes #24311 - - - - - e43788d0 by Jason Shipman at 2024-01-14T12:47:38-05:00 Add more instances for Compose: Fractional, RealFrac, Floating, RealFloat CLC proposal #226 https://github.com/haskell/core-libraries-committee/issues/226 - - - - - ae6d8cd2 by Sebastian Graf at 2024-01-14T12:48:15-05:00 Pmc: COMPLETE pragmas associated with Family TyCons should apply to representation TyCons as well (#24326) Fixes #24326. - - - - - c5fc7304 by sheaf at 2024-01-15T14:15:29-05:00 Use lookupOccRn_maybe in TH.lookupName When looking up a value, we want to be able to find both variables and record fields. So we should not use the lookupSameOccRn_maybe function, as we can't know ahead of time which record field namespace a record field with the given textual name will belong to. Fixes #24293 - - - - - da908790 by Krzysztof Gogolewski at 2024-01-15T14:16:05-05:00 Make the build more strict on documentation errors * Detect undefined labels. This can be tested by adding :ref:`nonexistent` to a documentation rst file; attempting to build docs will fail. Fixed the undefined label in `9.8.1-notes.rst`. * Detect errors. While we have plenty of warnings, we can at least enforce that Sphinx does not report errors. Fixed the error in `required_type_arguments.rst`. Unrelated change: I have documented that the `-dlint` enables `-fcatch-nonexhaustive-cases`, as can be verified by checking `enableDLint`. - - - - - 5077416e by Javier Sagredo at 2024-01-16T15:40:06-05:00 Profiling: Adds an option to not start time profiling at startup Using the functionality provided by d89deeba47ce04a5198a71fa4cbc203fe2c90794, this patch creates a new rts flag `--no-automatic-time-samples` which disables the time profiling when starting a program. It is then expected that the user starts it whenever it is needed. Fixes #24337 - - - - - 5776008c by Matthew Pickering at 2024-01-16T15:40:42-05:00 eventlog: Fix off-by-one error in postIPE We were missing the extra_comma from the calculation of the size of the payload of postIPE. This was causing assertion failures when the event would overflow the buffer by one byte, as ensureRoomForVariable event would report there was enough space for `n` bytes but then we would write `n + 1` bytes into the buffer. Fixes #24287 - - - - - 66dc09b1 by Simon Peyton Jones at 2024-01-16T15:41:18-05:00 Improve SpecConstr (esp nofib/spectral/ansi) This MR makes three improvements to SpecConstr: see #24282 * It fixes an outright (and recently-introduced) bug in `betterPat`, which was wrongly forgetting to compare the lengths of the argument lists. * It enhances ConVal to inclue a boolean for work-free-ness, so that the envt can contain non-work-free constructor applications, so that we can do more: see Note [ConVal work-free-ness] * It rejigs `subsumePats` so that it doesn't reverse the list. This can make a difference because, when patterns overlap, we arbitrarily pick the first. There is no "right" way, but this retains the old pre-subsumePats behaviour, thereby "fixing" the regression in #24282. Nofib results +======================================== | spectral/ansi -21.14% | spectral/hartel/comp_lab_zift -0.12% | spectral/hartel/parstof +0.09% | spectral/last-piece -2.32% | spectral/multiplier +6.03% | spectral/para +0.60% | spectral/simple -0.26% +======================================== | geom mean -0.18% +---------------------------------------- The regression in `multiplier` is sad, but it simply replicates GHC's previous behaviour (e.g. GHC 9.6). - - - - - 65da79b3 by Matthew Pickering at 2024-01-16T15:41:54-05:00 hadrian: Reduce Cabal verbosity The comment claims that `simpleUserHooks` decrease verbosity, and it does, but only for the `postConf` phase. The other phases are too verbose with `-V`. At the moment > 5000 lines of the build log are devoted to output from `cabal copy`. So I take the simple approach and just decrease the verbosity level again. If the output of `postConf` is essential then it would be better to implement our own `UserHooks` which doesn't decrease the verbosity for `postConf`. Fixes #24338 - - - - - 16414d7d by Matthew Pickering at 2024-01-17T10:54:59-05:00 Stop retaining old ModGuts throughout subsequent simplifier phases Each phase of the simplifier typically rewrites the majority of ModGuts, so we want to be able to release the old ModGuts as soon as possible. `name_ppr_ctxt` lives throught the whole optimiser phase and it was retaining a reference to `ModGuts`, so we were failing to release the old `ModGuts` until the end of the phase (potentially doubling peak memory usage for that particular phase). This was discovered using eras profiling (#24332) Fixes #24328 - - - - - 7f0879e1 by Matthew Pickering at 2024-01-17T10:55:35-05:00 Update nofib submodule - - - - - 320454d3 by Cheng Shao at 2024-01-17T23:02:40+00:00 ci: bump ci-images for updated wasm image - - - - - 2eca52b4 by Cheng Shao at 2024-01-17T23:06:44+00:00 base: treat all FDs as "nonblocking" on wasm On posix platforms, when performing read/write on FDs, we check the nonblocking flag first. For FDs without this flag (e.g. stdout), we call fdReady() first, which in turn calls poll() to wait for I/O to be available on that FD. This is problematic for wasm32-wasi: although select()/poll() is supported via the poll_oneoff() wasi syscall, that syscall is rather heavyweight and runtime behavior differs in different wasi implementations. The issue is even worse when targeting browsers, given there's no satisfactory way to implement async I/O as a synchronous syscall, so existing JS polyfills for wasi often give up and simply return ENOSYS. Before we have a proper I/O manager that avoids poll_oneoff() for async I/O on wasm, this patch improves the status quo a lot by merely pretending all FDs are "nonblocking". Read/write on FDs will directly invoke read()/write(), which are much more reliably handled in existing wasi implementations, especially those in browsers. Fixes #23275 and the following test cases: T7773 isEOF001 openFile009 T4808 cgrun025 Approved by CLC proposal #234: https://github.com/haskell/core-libraries-committee/issues/234 - - - - - 83c6c710 by Andrew Lelechenko at 2024-01-18T05:21:49-05:00 base: clarify how to disable warnings about partiality of Data.List.{head,tail} - - - - - c4078f2f by Simon Peyton Jones at 2024-01-18T05:22:25-05:00 Fix four bug in handling of (forall cv. body_ty) These bugs are all described in #24335 It's not easy to provoke the bug, hence no test case. - - - - - 119586ea by Alexis King at 2024-01-19T00:08:00-05:00 Always refresh profiling CCSes after running pending initializers Fixes #24171. - - - - - 9718d970 by Oleg Grenrus at 2024-01-19T00:08:36-05:00 Set default-language: GHC2021 in ghc library Go through compiler/ sources, and remove all BangPatterns (and other GHC2021 enabled extensions in these files). - - - - - 3ef71669 by Matthew Pickering at 2024-01-19T21:55:16-05:00 testsuite: Remove unused have_library function Also remove the hence unused testsuite option `--test-package-db`. Fixes #24342 - - - - - 5b7fa20c by Jade at 2024-01-19T21:55:53-05:00 Fix Spelling in the compiler Tracking: #16591 - - - - - 09875f48 by Matthew Pickering at 2024-01-20T12:20:44-05:00 testsuite: Implement `isInTreeCompiler` in a more robust way Just a small refactoring to avoid redundantly specifying the same strings in two different places. - - - - - 0d12b987 by Jade at 2024-01-20T12:21:20-05:00 Change maintainer email from cvs-ghc at haskell.org to ghc-devs at haskell.org. Fixes #22142 - - - - - 1fa1c00c by Jade at 2024-01-23T19:17:03-05:00 Enhance Documentation of functions exported by Data.Function This patch aims to improve the documentation of functions exported in Data.Function Tracking: #17929 Fixes: #10065 - - - - - ab47a43d by Jade at 2024-01-23T19:17:39-05:00 Improve documentation of hGetLine. - Add explanation for whether a newline is returned - Add examples Fixes #14804 - - - - - dd4af0e5 by Cheng Shao at 2024-01-23T19:18:17-05:00 Fix genapply for cross-compilation by nuking fragile CPP logic This commit fixes incorrectly built genapply when cross compiling (#24347) by nuking all fragile CPP logic in it from the orbit. All target-specific info are now read from DerivedConstants.h at runtime, see added note for details. Also removes a legacy Makefile and adds haskell language server support for genapply. - - - - - 0cda2b8b by Cheng Shao at 2024-01-23T19:18:17-05:00 rts: enable wasm32 register mapping The wasm backend didn't properly make use of all Cmm global registers due to #24347. Now that it is fixed, this patch re-enables full register mapping for wasm32, and we can now generate smaller & faster wasm modules that doesn't always spill arguments onto the stack. Fixes #22460 #24152. - - - - - 0325a6e5 by Greg Steuck at 2024-01-24T01:29:44-05:00 Avoid utf8 in primops.txt.pp comments They don't make it through readFile' without explicitly setting the encoding. See https://gitlab.haskell.org/ghc/ghc/-/issues/17755 - - - - - 1aaf0bd8 by David Binder at 2024-01-24T01:30:20-05:00 Bump hpc and hpc-bin submodule Bump hpc to 0.7.0.1 Bump hpc-bin to commit d1780eb2 - - - - - e693a4e8 by Ben Gamari at 2024-01-24T01:30:56-05:00 testsuite: Ignore stderr in T8089 Otherwise spurious "Killed: 9" messages to stderr may cause the test to fail. Fixes #24361. - - - - - a40f4ab2 by sheaf at 2024-01-24T14:04:33-05:00 Fix FMA instruction on LLVM We were emitting the wrong instructions for fused multiply-add operations on LLVM: - the instruction name is "llvm.fma.f32" or "llvm.fma.f64", not "fmadd" - LLVM does not support other instructions such as "fmsub"; instead we implement these by flipping signs of some arguments - the instruction is an LLVM intrinsic, which requires handling it like a normal function call instead of a machine instruction Fixes #24223 - - - - - 69abc786 by Andrei Borzenkov at 2024-01-24T14:05:09-05:00 Add changelog entry for renaming tuples from (,,...,,) to Tuple<n> (24291) - - - - - 0ac8f385 by Cheng Shao at 2024-01-25T00:27:48-05:00 compiler: remove unused GHC.Linker module The GHC.Linker module is empty and unused, other than as a hack for the make build system. We can remove it now that make is long gone; the note is moved to GHC.Linker.Loader instead. - - - - - 699da01b by Hécate Moonlight at 2024-01-25T00:28:27-05:00 Clarification for newtype constructors when using `coerce` - - - - - b2d8cd85 by Matt Walker at 2024-01-26T09:50:08-05:00 Fix #24308 Add tests for semicolon separated where clauses - - - - - 0da490a1 by Ben Gamari at 2024-01-26T17:34:41-05:00 hsc2hs: Bump submodule - - - - - 3f442fd2 by Ben Gamari at 2024-01-26T17:34:41-05:00 Bump containers submodule to 0.7 - - - - - 82a1c656 by Sebastian Nagel at 2024-01-29T02:32:40-05:00 base: with{Binary}File{Blocking} only annotates own exceptions Fixes #20886 This ensures that inner, unrelated exceptions are not misleadingly annotated with the opened file. - - - - - 9294a086 by Andreas Klebinger at 2024-01-29T02:33:15-05:00 Fix fma warning when using llvm on aarch64. On aarch64 fma is always on so the +fma flag doesn't exist for that target. Hence no need to try and pass +fma to llvm. Fixes #24379 - - - - - ced2e731 by sheaf at 2024-01-29T17:27:12-05:00 No shadowing warnings for NoFieldSelector fields This commit ensures we don't emit shadowing warnings when a user shadows a field defined with NoFieldSelectors. Fixes #24381 - - - - - 8eeadfad by Patrick at 2024-01-29T17:27:51-05:00 Fix bug wrong span of nested_doc_comment #24378 close #24378 1. Update the start position of span in `nested_doc_comment` correctly. and hence the spans of identifiers of haddoc can be computed correctly. 2. add test `HaddockSpanIssueT24378`. - - - - - a557580f by Alexey Radkov at 2024-01-30T19:41:52-05:00 Fix irrelevant dodgy-foreign-imports warning on import f-pointers by value A test *сс018* is attached (not sure about the naming convention though). Note that without the fix, the test fails with the *dodgy-foreign-imports* warning passed to stderr. The warning disappears after the fix. GHC shouldn't warn on imports of natural function pointers from C by value (which is feasible with CApiFFI), such as ```haskell foreign import capi "cc018.h value f" f :: FunPtr (Int -> IO ()) ``` where ```c void (*f)(int); ``` See a related real-world use-case [here](https://gitlab.com/daniel-casanueva/pcre-light/-/merge_requests/17). There, GHC warns on import of C function pointer `pcre_free`. - - - - - ca99efaf by Alexey Radkov at 2024-01-30T19:41:53-05:00 Rename test cc018 -> T24034 - - - - - 88c38dd5 by Ben Gamari at 2024-01-30T19:42:28-05:00 rts/TraverseHeap.c: Ensure that PosixSource.h is included first - - - - - ca2e919e by Simon Peyton Jones at 2024-01-31T09:29:45+00:00 Make decomposeRuleLhs a bit more clever This fixes #24370 by making decomposeRuleLhs undertand dictionary /functions/ as well as plain /dictionaries/ - - - - - 94ce031d by Teo Camarasu at 2024-02-01T05:49:49-05:00 doc: Add -Dn flag to user guide Resolves #24394 - - - - - 31553b11 by Ben Gamari at 2024-02-01T12:21:29-05: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. - - - - - 0785cf81 by Ben Gamari at 2024-02-01T12:21:29-05:00 codeGen: Use relaxed accesses in ticky bumping - - - - - be423dda by Ben Gamari at 2024-02-01T12:21:29-05:00 base: use atomic write when updating timer manager - - - - - 8a310e35 by Ben Gamari at 2024-02-01T12:21:29-05:00 Use relaxed atomics to manipulate TSO status fields - - - - - d6809ee4 by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Add necessary barriers when manipulating TSO owner - - - - - 39e3ac5d by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Use `switch` to branch on why_blocked This is a semantics-preserving refactoring. - - - - - 515eb33d by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix synchronization on thread blocking state We now use a release barrier whenever we update a thread's blocking state. This required widening StgTSO.why_blocked as AArch64 does not support atomic writes on 16-bit values. - - - - - eb38812e by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS and only needs relaxed ordering. - - - - - 26c48dd6 by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix data race in threadStatus# - - - - - 6af43ab4 by Ben Gamari at 2024-02-01T12:21:29-05:00 rts: Fix data race in Interpreter's preemption check - - - - - 9502ad3c by Ben Gamari at 2024-02-01T12:21:29-05:00 rts/Messages: Fix data race - - - - - 60802db5 by Ben Gamari at 2024-02-01T12:21:30-05:00 rts/Prof: Fix data race - - - - - ef8ccef5 by Ben Gamari at 2024-02-01T12:21:30-05:00 rts: Use relaxed ordering on dirty/clean info tables updates When changing the dirty/clean state of a mutable object we needn't have any particular ordering. - - - - - 76fe2b75 by Ben Gamari at 2024-02-01T12:21:30-05:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - a6316eb4 by Ben Gamari at 2024-02-01T12:21:30-05:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 6bddfd3d by Ben Gamari at 2024-02-01T12:21:30-05:00 rts: Use fence rather than redundant load Previously we would use an atomic load to ensure acquire ordering. However, we now have `ACQUIRE_FENCE_ON`, which allows us to express this more directly. - - - - - 55c65dbc by Ben Gamari at 2024-02-01T12:21:30-05:00 rts: Fix data races in profiling timer - - - - - 856b5e75 by Ben Gamari at 2024-02-01T12:21:30-05:00 Add Note [C11 memory model] - - - - - 6534da24 by Cheng Shao at 2024-02-01T12:22:07-05:00 compiler: move generic cmm optimization logic in NCG to a standalone module This commit moves GHC.CmmToAsm.cmmToCmm to a standalone module, GHC.Cmm.GenericOpt. The main motivation is enabling this logic to be run in the wasm backend NCG code, which is defined in other modules that's imported by GHC.CmmToAsm, causing a cyclic dependency issue. - - - - - 87e34888 by Cheng Shao at 2024-02-01T12:22:07-05:00 compiler: explicitly disable PIC in wasm32 NCG This commit explicitly disables the ncgPIC flag for the wasm32 target. The wasm backend doesn't support PIC for the time being. - - - - - c6ce242e by Cheng Shao at 2024-02-01T12:22:07-05:00 compiler: enable generic cmm optimizations in wasm backend NCG This commit enables the generic cmm optimizations in other NCGs to be run in the wasm backend as well, followed by a late cmm control-flow optimization pass. The added optimizations do catch some corner cases not handled by the pre-NCG cmm pipeline and are useful in generating smaller CFGs. - - - - - 151dda4e by Andrei Borzenkov at 2024-02-01T12:22:43-05:00 Namespacing for WARNING/DEPRECATED pragmas (#24396) New syntax for WARNING and DEPRECATED pragmas was added, namely namespace specifierss: namespace_spec ::= 'type' | 'data' | {- empty -} warning ::= warning_category namespace_spec namelist strings deprecation ::= namespace_spec namelist strings A new data type was introduced to represent these namespace specifiers: data NamespaceSpecifier = NoSpecifier | TypeNamespaceSpecifier (EpToken "type") | DataNamespaceSpecifier (EpToken "data") Extension field XWarning now contains this NamespaceSpecifier. lookupBindGroupOcc function was changed: it now takes NamespaceSpecifier and checks that the namespace of the found names matches the passed flag. With this change {-# WARNING data D "..." #-} pragma will only affect value namespace and {-# WARNING type D "..." #-} will only affect type namespace. The same logic is applicable to DEPRECATED pragmas. Finding duplicated warnings inside rnSrcWarnDecls now takes into consideration NamespaceSpecifier flag to allow warnings with the same names that refer to different namespaces. - - - - - 38c3afb6 by Bryan Richter at 2024-02-01T12:23:19-05:00 CI: Disable the test-cabal-reinstall job Fixes #24363 - - - - - 27020458 by Matthew Craven at 2024-02-03T01:53:26-05:00 Bump bytestring submodule to something closer to 0.12.1 ...mostly so that 16d6b7e835ffdcf9b894e79f933dd52348dedd0c (which reworks unaligned writes in Builder) and the stuff in https://github.com/haskell/bytestring/pull/631 can see wider testing. The less-terrible code for unaligned writes used in Builder on hosts not known to be ulaigned-friendly also takes less effort for GHC to compile, resulting in a metric decrease for T21839c on some platforms. The metric increase on T21839r is caused by the unrelated commit 750dac33465e7b59100698a330b44de7049a345c. It perhaps warrants further analysis and discussion (see #23822) but is not critical. Metric Decrease: T21839c Metric Increase: T21839r - - - - - cdddeb0f by Rodrigo Mesquita at 2024-02-03T01:54:02-05:00 Work around autotools setting C11 standard in CC/CXX In autoconf >=2.70, C11 is set by default for $CC and $CXX via the -std=...11 flag. In this patch, we split the "-std" flag out of the $CC and $CXX variables, which we traditionally assume to be just the executable name/path, and move it to $CFLAGS/$CXXFLAGS instead. Fixes #24324 - - - - - 5ff7cc26 by Apoorv Ingle at 2024-02-03T13:14:46-06:00 Expand `do` blocks right before typechecking using the `HsExpansion` philosophy. - Fixes #18324 #20020 #23147 #22788 #15598 #22086 #21206 - The change is detailed in - Note [Expanding HsDo with HsExpansion] in `GHC.Tc.Gen.Do` - Note [Doing HsExpansion in the Renamer vs Typechecker] in `GHC.Rename.Expr` expains the rational of doing expansions in type checker as opposed to in the renamer - Adds new datatypes: - `GHC.Hs.Expr.XXExprGhcRn`: new datatype makes this expansion work easier 1. Expansion bits for Expressions, Statements and Patterns in (`ExpandedThingRn`) 2. `PopErrCtxt` a special GhcRn Phase only artifcat to pop the previous error message in the error context stack - `GHC.Basic.Origin` now tracks the reason for expansion in case of Generated This is useful for type checking cf. `GHC.Tc.Gen.Expr.tcExpr` case for `HsLam` - Kills `HsExpansion` and `HsExpanded` as we have inlined them in `XXExprGhcRn` and `XXExprGhcTc` - Ensures warnings such as 1. Pattern match checks 2. Failable patterns 3. non-() return in body statements are preserved - Kill `HsMatchCtxt` in favor of `TcMatchAltChecker` - Testcases: * T18324 T20020 T23147 T22788 T15598 T22086 * T23147b (error message check), * DoubleMatch (match inside a match for pmc check) * pattern-fails (check pattern match with non-refutable pattern, eg. newtype) * Simple-rec (rec statements inside do statment) * T22788 (code snippet from #22788) * DoExpanion1 (Error messages for body statments) * DoExpansion2 (Error messages for bind statements) * DoExpansion3 (Error messages for let statements) Also repoint haddock to the right submodule so that the test (haddockHypsrcTest) pass Metric Increase 'compile_time/bytes allocated': T9020 The testcase is a pathalogical example of a `do`-block with many statements that do nothing. Given that we are expanding the statements into function binds, we will have to bear a (small) 2% cost upfront in the compiler to unroll the statements. - - - - - 0df8ce27 by Vladislav Zavialov at 2024-02-04T03:55:14-05:00 Reduce parser allocations in allocateCommentsP In the most common case, the comment queue is empty, so we can skip the work of processing it. This reduces allocations by about 10% in the parsing001 test. Metric Decrease: MultiLayerModulesRecomp parsing001 - - - - - cfd68290 by Simon Peyton Jones at 2024-02-05T17:58:33-05:00 Stop dropping a case whose binder is demanded This MR fixes #24251. See Note [Case-to-let for strictly-used binders] in GHC.Core.Opt.Simplify.Iteration, plus #24251, for lots of discussion. Final Nofib changes over 0.1%: +----------------------------------------- | imaginary/digits-of-e2 -2.16% | imaginary/rfib -0.15% | real/fluid -0.10% | real/gamteb -1.47% | real/gg -0.20% | real/maillist +0.19% | real/pic -0.23% | real/scs -0.43% | shootout/n-body -0.41% | shootout/spectral-norm -0.12% +======================================== | geom mean -0.05% Pleasingly, overall executable size is down by just over 1%. Compile times (in perf/compiler) wobble around a bit +/- 0.5%, but the geometric mean is -0.1% which seems good. - - - - - e4d137bb by Simon Peyton Jones at 2024-02-05T17:58:33-05:00 Add Note [Bangs in Integer functions] ...to document the bangs in the functions in GHC.Num.Integer - - - - - ce90f12f by Andrei Borzenkov at 2024-02-05T17:59:09-05:00 Hide WARNING/DEPRECATED namespacing under -XExplicitNamespaces (#24396) - - - - - e2ea933f by Simon Peyton Jones at 2024-02-06T10:12:04-05:00 Refactoring in preparation for lazy skolemisation * Make HsMatchContext and HsStmtContext be parameterised over the function name itself, rather than over the pass. See [mc_fun field of FunRhs] in Language.Haskell.Syntax.Expr - Replace types HsMatchContext GhcPs --> HsMatchContextPs HsMatchContext GhcRn --> HsMatchContextRn HsMatchContext GhcTc --> HsMatchContextRn (sic! not Tc) HsStmtContext GhcRn --> HsStmtContextRn - Kill off convertHsMatchCtxt * Split GHC.Tc.Type.BasicTypes.TcSigInfo so that TcCompleteSig (describing a complete user-supplied signature) is its own data type. - Split TcIdSigInfo(CompleteSig, PartialSig) into TcCompleteSig(CSig) TcPartialSig(PSig) - Use TcCompleteSig in tcPolyCheck, CheckGen - Rename types and data constructors: TcIdSigInfo --> TcIdSig TcPatSynInfo(TPSI) --> TcPatSynSig(PatSig) - Shuffle around helper functions: tcSigInfoName (moved to GHC.Tc.Types.BasicTypes) completeSigPolyId_maybe (moved to GHC.Tc.Types.BasicTypes) tcIdSigName (inlined and removed) tcIdSigLoc (introduced) - Rearrange the pattern match in chooseInferredQuantifiers * Rename functions and types: tcMatchesCase --> tcCaseMatches tcMatchesFun --> tcFunBindMatches tcMatchLambda --> tcLambdaMatches tcPats --> tcMatchPats matchActualFunTysRho --> matchActualFunTys matchActualFunTySigma --> matchActualFunTy * Add HasDebugCallStack constraints to: mkBigCoreVarTupTy, mkBigCoreTupTy, boxTy, mkPiTy, mkPiTys, splitAppTys, splitTyConAppNoView_maybe * Use `penv` from the outer context in the inner loop of GHC.Tc.Gen.Pat.tcMultiple * Move tcMkVisFunTy, tcMkInvisFunTy, tcMkScaledFunTys down the file, factor out and export tcMkScaledFunTy. * Move isPatSigCtxt down the file. * Formatting and comments Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - f5d3e03c by Andrei Borzenkov at 2024-02-06T10:12:04-05:00 Lazy skolemisation for @a-binders (#17594) This patch is a preparation for @a-binders implementation. The main changes are: * Skolemisation is now prepared to deal with @binders. See Note [Skolemisation overview] in GHC.Tc.Utils.Unify. Most of the action is in - Utils.Unify.matchExpectedFunTys - Gen.Pat.tcMatchPats - Gen.Expr.tcPolyExprCheck - Gen.Binds.tcPolyCheck Some accompanying refactoring: * I found that funTyConAppTy_maybe was doing a lot of allocation, and rejigged userTypeError_maybe to avoid calling it. - - - - - 532993c8 by Zubin Duggal at 2024-02-06T10:12:41-05:00 driver: Really don't lose track of nodes when we fail to resolve cycles This fixes a bug in 8db8d2fd1c881032b1b360c032b6d9d072c11723, where we could lose track of acyclic components at the start of an unresolved cycle. We now ensure we never loose track of any of these components. As T24275 demonstrates, a "cyclic" SCC might not really be a true SCC: When viewed without boot files, we have a single SCC ``` [REC main:T24275B [main:T24275B {-# SOURCE #-}, main:T24275A {-# SOURCE #-}] main:T24275A [main:T24275A {-# SOURCE #-}]] ``` But with boot files this turns into ``` [NONREC main:T24275B {-# SOURCE #-} [], REC main:T24275B [main:T24275B {-# SOURCE #-}, main:T24275A {-# SOURCE #-}] main:T24275A {-# SOURCE #-} [main:T24275B], NONREC main:T24275A [main:T24275A {-# SOURCE #-}]] ``` Note that this is truly not an SCC, as no nodes are reachable from T24275B.hs-boot. However, we treat this entire group as a single "SCC" because it seems so when we analyse the graph without taking boot files into account. Indeed, we must return a single ResolvedCycle element in the BuildPlan for this as described in Note [Upsweep]. However, since after resolving this is not a true SCC anymore, `findCycle` fails to find a cycle and we have a sub-optimal error message as a result. To handle this, I extended `findCycle` to not assume its input is an SCC, and to try harder to find cycles in its input. Fixes #24275 - - - - - b35dd613 by Zubin Duggal at 2024-02-06T10:13:17-05:00 GHCi: Lookup breakpoint CCs in the correct module We need to look up breakpoint CCs in the module that the breakpoint points to, and not the current module. Fixes #24327 - - - - - b09e6958 by Zubin Duggal at 2024-02-06T10:13:17-05:00 testsuite: Add test for #24327 - - - - - 569b4c10 by doyougnu at 2024-02-07T03:06:26-05:00 ts: add compile_artifact, ignore_extension flag In b521354216f2821e00d75f088d74081d8b236810 the testsuite gained the capability to collect generic metrics. But this assumed that the test was not linking and producing artifacts and we only wanted to track object files, interface files, or build artifacts from the compiler build. However, some backends, such as the JS backend, produce artifacts when compiling, such as the jsexe directory which we want to track. This patch: - tweaks the testsuite to collect generic metrics on any build artifact in the test directory. - expands the exe_extension function to consider windows and adds the ignore_extension flag. - Modifies certain tests to add the ignore_extension flag. Tests such as heaprof002 expect a .ps file, but on windows without ignore_extensions the testsuite will look for foo.exe.ps. Hence the flag. - adds the size_hello_artifact test - - - - - 75a31379 by doyougnu at 2024-02-07T03:06:26-05:00 ts: add wasm_arch, heapprof002 wasm extension - - - - - c9731d6d by Rodrigo Mesquita at 2024-02-07T03:07:03-05:00 Synchronize bindist configure for #24324 In cdddeb0f1280b40cc194028bbaef36e127175c4c, we set up a workaround for #24324 in the in-tree configure script, but forgot to update the bindist configure script accordingly. This updates it. - - - - - d309f4e7 by Matthew Pickering at 2024-02-07T03:07:38-05:00 distrib/configure: Fix typo in CONF_GCC_LINKER_OPTS_STAGE2 variable Instead we were setting CONF_GCC_LINK_OPTS_STAGE2 which meant that we were missing passing `--target` when invoking the linker. Fixes #24414 - - - - - 77db84ab by Ben Gamari at 2024-02-08T00:35:22-05:00 llvmGen: Adapt to allow use of new pass manager. We now must use `-passes` in place of `-O<n>` due to #21936. Closes #21936. - - - - - 3c9ddf97 by Matthew Pickering at 2024-02-08T00:35:59-05:00 testsuite: Mark length001 as fragile on javascript Modifying the timeout multiplier is not a robust way to get this test to reliably fail. Therefore we mark it as fragile until/if javascript ever supports the stack limit. - - - - - 20b702b5 by Matthew Pickering at 2024-02-08T00:35:59-05:00 Javascript: Don't filter out rtsDeps list This logic appears to be incorrect as it would drop any dependency which was not in a direct dependency of the package being linked. In the ghc-internals split this started to cause errors because `ghc-internal` is not a direct dependency of most packages, and hence important symbols to keep which are hard coded into the js runtime were getting dropped. - - - - - 2df96366 by Ben Gamari at 2024-02-08T00:35:59-05:00 base: Cleanup whitespace in cbits - - - - - 44f6557a by Ben Gamari at 2024-02-08T00:35:59-05:00 Move `base` to `ghc-internal` Here we move a good deal of the implementation of `base` into a new package, `ghc-internal` such that it can be evolved independently from the user-visible interfaces of `base`. While we want to isolate implementation from interfaces, naturally, we would like to avoid turning `base` into a mere set of module re-exports. However, this is a non-trivial undertaking for a variety of reasons: * `base` contains numerous known-key and wired-in things, requiring corresponding changes in the compiler * `base` contains a significant amount of C code and corresponding autoconf logic, which is very fragile and difficult to break apart * `base` has numerous import cycles, which are currently dealt with via carefully balanced `hs-boot` files * We must not break existing users To accomplish this migration, I tried the following approaches: * [Split-GHC.Base]: Break apart the GHC.Base knot to allow incremental migration of modules into ghc-internal: this knot is simply too intertwined to be easily pulled apart, especially given the rather tricky import cycles that it contains) * [Move-Core]: Moving the "core" connected component of base (roughly 150 modules) into ghc-internal. While the Haskell side of this seems tractable, the C dependencies are very subtle to break apart. * [Move-Incrementally]: 1. Move all of base into ghc-internal 2. Examine the module structure and begin moving obvious modules (e.g. leaves of the import graph) back into base 3. Examine the modules remaining in ghc-internal, refactor as necessary to facilitate further moves 4. Go to (2) iterate until the cost/benefit of further moves is insufficient to justify continuing 5. Rename the modules moved into ghc-internal to ensure that they don't overlap with those in base 6. For each module moved into ghc-internal, add a shim module to base with the declarations which should be exposed and any requisite Haddocks (thus guaranteeing that base will be insulated from changes in the export lists of modules in ghc-internal Here I am using the [Move-Incrementally] approach, which is empirically the least painful of the unpleasant options above Bumps haddock submodule. Metric Decrease: haddock.Cabal haddock.base Metric Increase: MultiComponentModulesRecomp T16875 size_hello_artifact - - - - - e8fb2451 by Vladislav Zavialov at 2024-02-08T00:36:36-05:00 Haddock comments on infix constructors (#24221) Rewrite the `HasHaddock` instance for `ConDecl GhcPs` to account for infix constructors. This change fixes a Haddock regression (introduced in 19e80b9af252) that affected leading comments on infix data constructor declarations: -- | Docs for infix constructor | Int :* Bool The comment should be associated with the data constructor (:*), not with its left-hand side Int. - - - - - 9060d55b by Ben Gamari at 2024-02-08T00:37:13-05:00 Add os-string as a boot package Introduces `os-string` submodule. This will be necessary for `filepath-1.5`. - - - - - 9d65235a by Ben Gamari at 2024-02-08T00:37:13-05:00 gitignore: Ignore .hadrian_ghci_multi/ - - - - - d7ee12ea by Ben Gamari at 2024-02-08T00:37:13-05:00 hadrian: Set -this-package-name When constructing the GHC flags for a package Hadrian must take care to set `-this-package-name` in addition to `-this-unit-id`. This hasn't broken until now as we have not had any uses of qualified package imports. However, this will change with `filepath-1.5` and the corresponding `unix` bump, breaking `hadrian/multi-ghci`. - - - - - f2dffd2e by Ben Gamari at 2024-02-08T00:37:13-05:00 Bump filepath to 1.5.0.0 Required bumps of the following submodules: * `directory` * `filepath` * `haskeline` * `process` * `unix` * `hsc2hs` * `Win32` * `semaphore-compat` and the addition of `os-string` as a boot package. - - - - - ab533e71 by Matthew Pickering at 2024-02-08T00:37:50-05:00 Use specific clang assembler when compiling with -fllvm There are situations where LLVM will produce assembly which older gcc toolchains can't handle. For example on Deb10, it seems that LLVM >= 13 produces assembly which the default gcc doesn't support. A more robust solution in the long term is to require a specific LLVM compatible assembler when using -fllvm. Fixes #16354 - - - - - c32b6426 by Matthew Pickering at 2024-02-08T00:37:50-05:00 Update CI images with LLVM 15, ghc-9.6.4 and cabal-install-3.10.2.0 - - - - - 5fcd58be by Matthew Pickering at 2024-02-08T00:37:50-05:00 Update bootstrap plans for 9.4.8 and 9.6.4 - - - - - 707a32f5 by Matthew Pickering at 2024-02-08T00:37:50-05:00 Add alpine 3_18 release job This is mainly experimental and future proofing to enable a smooth transition to newer alpine releases once 3_12 is too old. - - - - - c37931b3 by John Ericson at 2024-02-08T06:39:05-05:00 Generate LLVM min/max bound policy via Hadrian Per #23966, I want the top-level configure to only generate configuration data for Hadrian, not do any "real" tasks on its own. This is part of that effort --- one less file generated by it. (It is still done with a `.in` file, so in a future world non-Hadrian also can easily create this file.) Split modules: - GHC.CmmToLlvm.Config - GHC.CmmToLlvm.Version - GHC.CmmToLlvm.Version.Bounds - GHC.CmmToLlvm.Version.Type This also means we can get rid of the silly `unused.h` introduced in !6803 / 7dfcab2f4bcb7206174ea48857df1883d05e97a2 as temporary kludge. Part of #23966 - - - - - 9f987235 by Apoorv Ingle at 2024-02-08T06:39:42-05:00 Enable mdo statements to use HsExpansions Fixes: #24411 Added test T24411 for regression - - - - - 762b2120 by Jade at 2024-02-08T15:17:15+00:00 Improve Monad, Functor & Applicative docs This patch aims to improve the documentation of Functor, Applicative, Monad and related symbols. The main goal is to make it more consistent and make accessible. See also: !10979 (closed) and !10985 (closed) Ticket #17929 Updates haddock submodule - - - - - 151770ca by Josh Meredith at 2024-02-10T14:28:15-05:00 JavaScript codegen: Use GHC's tag inference where JS backend-specific evaluation inference was previously used (#24309) - - - - - 2e880635 by Zubin Duggal at 2024-02-10T14:28:51-05:00 ci: Allow release-hackage-lint to fail Otherwise it blocks the ghcup metadata pipeline from running. - - - - - b0293f78 by Matthew Pickering at 2024-02-10T14:29:28-05:00 rts: eras profiling mode The eras profiling mode is useful for tracking the life-time of closures. When a closure is written, the current era is recorded in the profiling header. This records the era in which the closure was created. * Enable with -he * User mode: Use functions ghc-experimental module GHC.Profiling.Eras to modify the era * Automatically: --automatic-era-increment, increases the user era on major collections * The first era is era 1 * -he<era> can be used with other profiling modes to select a specific era If you just want to record the era but not to perform heap profiling you can use `-he --no-automatic-heap-samples`. https://well-typed.com/blog/2024/01/ghc-eras-profiling/ Fixes #24332 - - - - - be674a2c by Jade at 2024-02-10T14:30:04-05:00 Adjust error message for trailing whitespace in as-pattern. Fixes #22524 - - - - - 53ef83f9 by doyougnu at 2024-02-10T14:30:47-05:00 gitlab: js: add codeowners Fixes: - #24409 Follow on from: - #21078 and MR !9133 - When we added the JS backend this was forgotten. This patch adds the rightful codeowners. - - - - - 8bbe12f2 by Matthew Pickering at 2024-02-10T14:31:23-05:00 Bump CI images so that alpine3_18 image includes clang15 The only changes here are that clang15 is now installed on the alpine-3_18 image. - - - - - df9fd9f7 by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: handle stored null StablePtr Some Haskell codes unsafely cast StablePtr into ptr to compare against NULL. E.g. in direct-sqlite: if castStablePtrToPtr aggStPtr /= nullPtr then where `aggStPtr` is read (`peek`) from zeroed memory initially. We fix this by giving these StablePtr the same representation as other null pointers. It's safe because StablePtr at offset 0 is unused (for this exact reason). - - - - - 55346ede by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: disable MergeObjsMode test This isn't implemented for JS backend objects. - - - - - aef587f6 by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: add support for linking C sources Support linking C sources with JS output of the JavaScript backend. See the added documentation in the users guide. The implementation simply extends the JS linker to use the objects (.o) that were already produced by the emcc compiler and which were filtered out previously. I've also added some options to control the link with C functions (see the documentation about pragmas). With this change I've successfully compiled the direct-sqlite package which embeds the sqlite.c database code. Some wrappers are still required (see the documentation about wrappers) but everything generic enough to be reused for other libraries have been integrated into rts/js/mem.js. - - - - - b71b392f by Sylvain Henry at 2024-02-12T12:18:42-05:00 JS: avoid EMCC logging spurious failure emcc would sometime output messages like: cache:INFO: generating system asset: symbol_lists/424b44514e43d789148e69e4e7d1c7fdc0350b79.json... (this will be cached in "/emsdk/upstream/emscripten/cache/symbol_lists/424b44514e43d789148e69e4e7d1c7fdc0350b79.json" for subsequent builds) cache:INFO: - ok Cf https://github.com/emscripten-core/emscripten/issues/18607 This breaks our tests matching the stderr output. We avoid this by setting EMCC_LOGGING=0 - - - - - ff2c0cc9 by Simon Peyton Jones at 2024-02-12T12:19:17-05:00 Remove a dead comment Just remove an out of date block of commented-out code, and tidy up the relevant Notes. See #8317. - - - - - bedb4f0d by Teo Camarasu at 2024-02-12T18:50:33-05:00 nonmoving: Add support for heap profiling Add support for heap profiling while using the nonmoving collector. We greatly simply the implementation by disabling concurrent collection for GCs when heap profiling is enabled. This entails that the marked objects on the nonmoving heap are exactly the live objects. Note that we match the behaviour for live bytes accounting by taking the size of objects on the nonmoving heap to be that of the segment's block rather than the object itself. Resolves #22221 - - - - - d0d5acb5 by Teo Camarasu at 2024-02-12T18:51:09-05:00 doc: Add requires prof annotation to options that require it Resolves #24421 - - - - - 57bb8c92 by Cheng Shao at 2024-02-13T14:07:49-05:00 deriveConstants: add needed constants for wasm backend This commit adds needed constants to deriveConstants. They are used by RTS code in the wasm backend to support the JSFFI logic. - - - - - 615eb855 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms The pure Haskell implementation causes i386 regression in unrelated work that can be fixed by using C-based atomic increment, see added comment for details. - - - - - a9918891 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: allow JSFFI for wasm32 This commit allows the javascript calling convention to be used when the target platform is wasm32. - - - - - 8771a53b by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: allow boxed JSVal as a foreign type This commit allows the boxed JSVal type to be used as a foreign argument/result type. - - - - - 053c92b3 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: ensure ctors have the right priority on wasm32 This commit fixes the priorities of ctors generated by GHC codegen on wasm32, see the referred note for details. - - - - - b7942e0a by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: add JSFFI desugar logic for wasm32 This commit adds JSFFI desugar logic for the wasm backend. - - - - - 2c1dca76 by Cheng Shao at 2024-02-13T14:07:49-05:00 compiler: add JavaScriptFFI to supported extension list on wasm32 This commit adds JavaScriptFFI as a supported extension when the target platform is wasm32. - - - - - 9ad0e2b4 by Cheng Shao at 2024-02-13T14:07:49-05:00 rts/ghc-internal: add JSFFI support logic for wasm32 This commit adds rts/ghc-internal logic to support the wasm backend's JSFFI functionality. - - - - - e9ebea66 by Cheng Shao at 2024-02-13T14:07:49-05:00 ghc-internal: fix threadDelay for wasm in browsers This commit fixes broken threadDelay for wasm when it runs in browsers, see added note for detailed explanation. - - - - - f85f3fdb by Cheng Shao at 2024-02-13T14:07:49-05:00 utils: add JSFFI utility code This commit adds JavaScript util code to utils to support the wasm backend's JSFFI functionality: - jsffi/post-link.mjs, a post-linker to process the linked wasm module and emit a small complement JavaScript ESM module to be used with it at runtime - jsffi/prelude.js, a tiny bit of prelude code as the JavaScript side of runtime logic - jsffi/test-runner.mjs, run the jsffi test cases Co-authored-by: amesgen <amesgen at amesgen.de> - - - - - 77e91500 by Cheng Shao at 2024-02-13T14:07:49-05:00 hadrian: distribute jsbits needed for wasm backend's JSFFI support The post-linker.mjs/prelude.js files are now distributed in the bindist libdir, so when using the wasm backend's JSFFI feature, the user wouldn't need to fetch them from a ghc checkout manually. - - - - - c47ba1c3 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: add opts.target_wrapper This commit adds opts.target_wrapper which allows overriding the target wrapper on a per test case basis when testing a cross target. This is used when testing the wasm backend's JSFFI functionality; the rest of the cases are tested using wasmtime, though the jsffi cases are tested using the node.js based test runner. - - - - - 8e048675 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: T22774 should work for wasm JSFFI T22774 works since the wasm backend now supports the JSFFI feature. - - - - - 1d07f9a6 by Cheng Shao at 2024-02-13T14:07:49-05:00 testsuite: add JSFFI test cases for wasm backend This commit adds a few test cases for the wasm backend's JSFFI functionality, as well as a simple README to instruct future contributors to add new test cases. - - - - - b8997080 by Cheng Shao at 2024-02-13T14:07:49-05:00 docs: add documentation for wasm backend JSFFI This commit adds changelog and user facing documentation for the wasm backend's JSFFI feature. - - - - - ffeb000d by David Binder at 2024-02-13T14:08:30-05:00 Add tests from libraries/process/tests and libraries/Win32/tests to GHC These tests were previously part of the libraries, which themselves are submodules of the GHC repository. This commit moves the tests directly to the GHC repository. - - - - - 5a932cf2 by David Binder at 2024-02-13T14:08:30-05:00 Do not execute win32 tests on non-windows runners - - - - - 500d8cb8 by Jade at 2024-02-13T14:09:07-05:00 prevent GHCi (and runghc) from suggesting other symbols when not finding main Fixes: #23996 - - - - - b19ec331 by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: update xxHash to v0.8.2 - - - - - 4a97bdb8 by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: use XXH3_64bits hash on all 64-bit platforms This commit enables XXH3_64bits hash to be used on all 64-bit platforms. Previously it was only enabled on x86_64, so platforms like aarch64 silently falls back to using XXH32 which degrades the hashing function quality. - - - - - ee01de7d by Cheng Shao at 2024-02-13T14:09:46-05:00 rts: define XXH_INLINE_ALL This commit cleans up how we include the xxhash.h header and only define XXH_INLINE_ALL, which is sufficient to inline the xxHash functions without symbol collision. - - - - - 0e01e1db by Alan Zimmerman at 2024-02-14T02:13:22-05:00 EPA: Move EpAnn out of extension points Leaving a few that are too tricky, maybe some other time. Also - remove some unneeded helpers from Parser.y - reduce allocations with strictness annotations Updates haddock submodule Metric Decrease: parsing001 - - - - - de589554 by Andreas Klebinger at 2024-02-14T02:13:59-05:00 Fix ffi callbacks with >6 args and non-64bit args. Check for ptr/int arguments rather than 64-bit width arguments when counting integer register arguments. The old approach broke when we stopped using exclusively W64-sized types to represent sub-word sized integers. Fixes #24314 - - - - - 325b7613 by Ben Gamari at 2024-02-14T14:27:45-05:00 rts/EventLog: Place eliminate duplicate strlens Previously many of the `post*` implementations would first compute the length of the event's strings in order to determine the event length. Later we would then end up computing the length yet again in `postString`. Now we instead pass the string length to `postStringLen`, avoiding the repeated work. - - - - - 8aafa51c by Ben Gamari at 2024-02-14T14:27:46-05:00 rts/eventlog: Place upper bound on IPE string field lengths The strings in IPE events may be of unbounded length. Limit the lengths of these fields to 64k characters to ensure that we don't exceed the maximum event length. - - - - - 0e60d52c by Zubin Duggal at 2024-02-14T14:27:46-05:00 rts: drop unused postString function - - - - - d8d1333a by Cheng Shao at 2024-02-14T14:28:23-05:00 compiler/rts: fix wasm unreg regression This commit fixes two wasm unreg regressions caught by a nightly pipeline: - Unknown stg_scheduler_loopzh symbol when compiling scheduler.cmm - Invalid _hs_constructor(101) function name when handling ctor - - - - - 264a4fa9 by Owen Shepherd at 2024-02-15T09:41:06-05:00 feat: Add sortOn to Data.List.NonEmpty Adds `sortOn` to `Data.List.NonEmpty`, and adds comments describing when to use it, compared to `sortWith` or `sortBy . comparing`. The aim is to smooth out the API between `Data.List`, and `Data.List.NonEmpty`. This change has been discussed in the [clc issue](https://github.com/haskell/core-libraries-committee/issues/227). - - - - - b57200de by Fendor at 2024-02-15T09:41:47-05:00 Prefer RdrName over OccName for looking up locations in doc renaming step Looking up by OccName only does not take into account when functions are only imported in a qualified way. Fixes issue #24294 Bump haddock submodule to include regression test - - - - - 8ad02724 by Luite Stegeman at 2024-02-15T17:33:32-05:00 JS: add simple optimizer The simple optimizer reduces the size of the code generated by the JavaScript backend without the complexity and performance penalty of the optimizer in GHCJS. Also see #22736 Metric Decrease: libdir size_hello_artifact - - - - - 20769b36 by Matthew Pickering at 2024-02-15T17:34:07-05:00 base: Expose `--no-automatic-time-samples` in `GHC.RTS.Flags` API This patch builds on 5077416e12cf480fb2048928aa51fa4c8fc22cf1 and modifies the base API to reflect the new RTS flag. CLC proposal #243 - https://github.com/haskell/core-libraries-committee/issues/243 Fixes #24337 - - - - - 08031ada by Teo Camarasu at 2024-02-16T13:37:00-05:00 base: export System.Mem.performBlockingMajorGC The corresponding C function was introduced in ba73a807edbb444c49e0cf21ab2ce89226a77f2e. As part of #22264. Resolves #24228 The CLC proposal was disccused at: https://github.com/haskell/core-libraries-committee/issues/230 Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 1f534c2e by Florian Weimer at 2024-02-16T13:37:42-05:00 Fix C output for modern C initiative GCC 14 on aarch64 rejects the C code written by GHC with this kind of error: error: assignment to ‘ffi_arg’ {aka ‘long unsigned int’} from ‘HsPtr’ {aka ‘void *’} makes integer from pointer without a cast [-Wint-conversion] 68 | *(ffi_arg*)resp = cret; | ^ Add the correct cast. For more information on this see: https://fedoraproject.org/wiki/Changes/PortingToModernC Tested-by: Richard W.M. Jones <rjones at redhat.com> - - - - - 5d3f7862 by Matthew Craven at 2024-02-16T13:38:18-05:00 Bump bytestring submodule to 0.12.1.0 - - - - - 902ebcc2 by Ian-Woo Kim at 2024-02-17T06:01:01-05:00 Add missing BCO handling in scavenge_one. - - - - - 97d26206 by Sylvain Henry at 2024-02-17T06:01:44-05:00 Make cast between words and floats real primops (#24331) First step towards fixing #24331. Replace foreign prim imports with real primops. - - - - - a40e4781 by Sylvain Henry at 2024-02-17T06:01:44-05:00 Perf: add constant folding for bitcast between float and word (#24331) - - - - - 5fd2c00f by Sylvain Henry at 2024-02-17T06:01:44-05:00 Perf: replace stack checks with assertions in casting primops There are RESERVED_STACK_WORDS free words (currently 21) on the stack, so omit the checks. Suggested by Cheng Shao. - - - - - 401dfe7b by Sylvain Henry at 2024-02-17T06:01:44-05:00 Reexport primops from GHC.Float + add deprecation - - - - - 4ab48edb by Ben Gamari at 2024-02-17T06:02:21-05:00 rts/Hash: Don't iterate over chunks if we don't need to free data When freeing a `HashTable` there is no reason to walk over the hash list before freeing it if the user has not given us a `dataFreeFun`. Noticed while looking at #24410. - - - - - bd5a1f91 by Cheng Shao at 2024-02-17T06:03:00-05:00 compiler: add SEQ_CST fence support In addition to existing Acquire/Release fences, this commit adds SEQ_CST fence support to GHC, allowing Cmm code to explicitly emit a fence that enforces total memory ordering. The following logic is added: - The MO_SeqCstFence callish MachOp - The %prim fence_seq_cst() Cmm syntax and the SEQ_CST_FENCE macro in Cmm.h - MO_SeqCstFence lowering logic in every single GHC codegen backend - - - - - 2ce2a493 by Cheng Shao at 2024-02-17T06:03:38-05:00 testsuite: fix hs_try_putmvar002 for targets without pthread.h hs_try_putmvar002 includes pthread.h and doesn't work on targets without this header (e.g. wasm32). It doesn't need to include this header at all. This was previously unnoticed by wasm CI, though recent toolchain upgrade brought in upstream changes that completely removes pthread.h in the single-threaded wasm32-wasi sysroot, therefore we need to handle that change. - - - - - 1fb3974e by Cheng Shao at 2024-02-17T06:03:38-05:00 ci: bump ci-images to use updated wasm image This commit bumps our ci-images revision to use updated wasm image. - - - - - 56e3f097 by Andrew Lelechenko at 2024-02-17T06:04:13-05:00 Bump submodule text to 2.1.1 T17123 allocates less because of improvements to Data.Text.concat in 1a6a06a. Metric Decrease: T17123 - - - - - a7569495 by Cheng Shao at 2024-02-17T06:04:51-05:00 rts: remove redundant rCCCS initialization This commit removes the redundant logic of initializing each Capability's rCCCS to CCS_SYSTEM in initProfiling(). Before initProfiling() is called during RTS startup, each Capability's rCCCS has already been assigned CCS_SYSTEM when they're first initialized. - - - - - 7a0293cc by Ben Gamari at 2024-02-19T07:11:00-05:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 0dbd729e by Andrei Borzenkov at 2024-02-19T07:11:37-05:00 Parser, renamer, type checker for @a-binders (#17594) GHC Proposal 448 introduces binders for invisible type arguments (@a-binders) in various contexts. This patch implements @-binders in lambda patterns and function equations: {-# LANGUAGE TypeAbstractions #-} id1 :: a -> a id1 @t x = x :: t -- @t-binder on the LHS of a function equation higherRank :: (forall a. (Num a, Bounded a) => a -> a) -> (Int8, Int16) higherRank f = (f 42, f 42) ex :: (Int8, Int16) ex = higherRank (\ @a x -> maxBound @a - x ) -- @a-binder in a lambda pattern in an argument -- to a higher-order function Syntax ------ To represent those @-binders in the AST, the list of patterns in Match now uses ArgPat instead of Pat: data Match p body = Match { ... - m_pats :: [LPat p], + m_pats :: [LArgPat p], ... } + data ArgPat pass + = VisPat (XVisPat pass) (LPat pass) + | InvisPat (XInvisPat pass) (HsTyPat (NoGhcTc pass)) + | XArgPat !(XXArgPat pass) The VisPat constructor represents patterns for visible arguments, which include ordinary value-level arguments and required type arguments (neither is prefixed with a @), while InvisPat represents invisible type arguments (prefixed with a @). Parser ------ In the grammar (Parser.y), the lambda and lambda-cases productions of aexp non-terminal were updated to accept argpats instead of apats: aexp : ... - | '\\' apats '->' exp + | '\\' argpats '->' exp ... - | '\\' 'lcases' altslist(apats) + | '\\' 'lcases' altslist(argpats) ... + argpat : apat + | PREFIX_AT atype Function left-hand sides did not require any changes to the grammar, as they were already parsed with productions capable of parsing @-binders. Those binders were being rejected in post-processing (isFunLhs), and now we accept them. In Parser.PostProcess, patterns are constructed with the help of PatBuilder, which is used as an intermediate data structure when disambiguating between FunBind and PatBind. In this patch we define ArgPatBuilder to accompany PatBuilder. ArgPatBuilder is a short-lived data structure produced in isFunLhs and consumed in checkFunBind. Renamer ------- Renaming of @-binders builds upon prior work on type patterns, implemented in 2afbddb0f24, which guarantees proper scoping and shadowing behavior of bound type variables. This patch merely defines rnLArgPatsAndThen to process a mix of visible and invisible patterns: + rnLArgPatsAndThen :: NameMaker -> [LArgPat GhcPs] -> CpsRn [LArgPat GhcRn] + rnLArgPatsAndThen mk = mapM (wrapSrcSpanCps rnArgPatAndThen) where + rnArgPatAndThen (VisPat x p) = ... rnLPatAndThen ... + rnArgPatAndThen (InvisPat _ tp) = ... rnHsTyPat ... Common logic between rnArgPats and rnPats is factored out into the rn_pats_general helper. Type checker ------------ Type-checking of @-binders builds upon prior work on lazy skolemisation, implemented in f5d3e03c56f. This patch extends tcMatchPats to handle @-binders. Now it takes and returns a list of LArgPat rather than LPat: tcMatchPats :: ... - -> [LPat GhcRn] + -> [LArgPat GhcRn] ... - -> TcM ([LPat GhcTc], a) + -> TcM ([LArgPat GhcTc], a) Invisible binders in the Match are matched up with invisible (Specified) foralls in the type. This is done with a new clause in the `loop` worker of tcMatchPats: loop :: [LArgPat GhcRn] -> [ExpPatType] -> TcM ([LArgPat GhcTc], a) loop (L l apat : pats) (ExpForAllPatTy (Bndr tv vis) : pat_tys) ... -- NEW CLAUSE: | InvisPat _ tp <- apat, isSpecifiedForAllTyFlag vis = ... In addition to that, tcMatchPats no longer discards type patterns. This is done by filterOutErasedPats in the desugarer instead. x86_64-linux-deb10-validate+debug_info Metric Increase: MultiLayerModulesTH_OneShot - - - - - 486979b0 by Jade at 2024-02-19T07:12:13-05:00 Add specialized sconcat implementation for Data.Monoid.First and Data.Semigroup.First Approved CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/246 Fixes: #24346 - - - - - 17e309d2 by John Ericson at 2024-02-19T07:12:49-05:00 Fix reST in users guide It appears that aef587f65de642142c1dcba0335a301711aab951 wasn't valid syntax. - - - - - 35b0ad90 by Brandon Chinn at 2024-02-19T07:13:25-05:00 Fix searching for errors in sphinx build - - - - - 4696b966 by Cheng Shao at 2024-02-19T07:14:02-05:00 hadrian: fix wasm backend post linker script permissions The post-link.mjs script was incorrectly copied and installed as a regular data file without executable permission, this commit fixes it. - - - - - a6142e0c by Cheng Shao at 2024-02-19T07:14:40-05:00 testsuite: mark T23540 as fragile on i386 See #24449 for details. - - - - - 249caf0d by Matthew Craven at 2024-02-19T20:36:09-05:00 Add @since annotation to Data.Data.mkConstrTag - - - - - cdd939e7 by Jade at 2024-02-19T20:36:46-05:00 Enhance documentation of Data.Complex - - - - - d04f384f by Ben Gamari at 2024-02-21T04:59:23-05:00 hadrian/bindist: Ensure that phony rules are marked as such Otherwise make may not run the rule if file with the same name as the rule happens to exist. - - - - - efcbad2d by Ben Gamari at 2024-02-21T04:59:23-05:00 hadrian: Generate HSC2HS_EXTRAS variable in bindist installation We must generate the hsc2hs wrapper at bindist installation time since it must contain `--lflag` and `--cflag` arguments which depend upon the installation path. The solution here is to substitute these variables in the configure script (see mk/hsc2hs.in). This is then copied over a dummy wrapper in the install rules. Fixes #24050. - - - - - c540559c by Matthew Pickering at 2024-02-21T04:59:23-05:00 ci: Show --info for installed compiler - - - - - ab9281a2 by Matthew Pickering at 2024-02-21T04:59:23-05:00 configure: Correctly set --target flag for linker opts Previously we were trying to use the FP_CC_SUPPORTS_TARGET with 4 arguments, when it only takes 3 arguments. Instead we need to use the `FP_PROG_CC_LINKER_TARGET` function in order to set the linker flags. Actually fixes #24414 - - - - - 9460d504 by Rodrigo Mesquita at 2024-02-21T04:59:59-05:00 configure: Do not override existing linker flags in FP_LD_NO_FIXUP_CHAINS - - - - - 77629e76 by Andrei Borzenkov at 2024-02-21T05:00:35-05:00 Namespacing for fixity signatures (#14032) Namespace specifiers were added to syntax of fixity signatures: - sigdecl ::= infix prec ops | ... + sigdecl ::= infix prec namespace_spec ops | ... To preserve namespace during renaming MiniFixityEnv type now has separate FastStringEnv fields for names that should be on the term level and for name that should be on the type level. makeMiniFixityEnv function was changed to fill MiniFixityEnv in the right way: - signatures without namespace specifiers fill both fields - signatures with 'data' specifier fill data field only - signatures with 'type' specifier fill type field only Was added helper function lookupMiniFixityEnv that takes care about looking for a name in an appropriate namespace. Updates haddock submodule. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 84357d11 by Teo Camarasu at 2024-02-21T05:01:11-05:00 rts: only collect live words in nonmoving census when non-concurrent This avoids segfaults when the mutator modifies closures as we examine them. Resolves #24393 - - - - - 9ca56dd3 by Ian-Woo Kim at 2024-02-21T05:01:53-05:00 mutex wrap in refreshProfilingCCSs - - - - - 1387966a by Cheng Shao at 2024-02-21T05:02:32-05:00 rts: remove unused HAVE_C11_ATOMICS macro This commit removes the unused HAVE_C11_ATOMICS macro. We used to have a few places that have fallback paths when HAVE_C11_ATOMICS is not defined, but that is completely redundant, since the FP_CC_SUPPORTS__ATOMICS configure check will fail when the C compiler doesn't support C11 style atomics. There are also many places (e.g. in unreg backend, SMP.h, library cbits, etc) where we unconditionally use C11 style atomics anyway which work in even CentOS 7 (gcc 4.8), the oldest distro we test in our CI, so there's no value in keeping HAVE_C11_ATOMICS. - - - - - 0f40d68f by Andreas Klebinger at 2024-02-21T05:03:09-05:00 RTS: -Ds - make sure incall is non-zero before dereferencing it. Fixes #24445 - - - - - e5886de5 by Ben Gamari at 2024-02-21T05:03:44-05:00 rts/AdjustorPool: Use ExecPage abstraction This is just a minor cleanup I found while reviewing the implementation. - - - - - 09941666 by Adam Gundry at 2024-02-21T13:53:12+00:00 Define GHC2024 language edition (#24320) See https://github.com/ghc-proposals/ghc-proposals/pull/613. Also fixes #24343 and improves the documentation of language editions. Co-authored-by: Joachim Breitner <mail at joachim-breitner.de> - - - - - 5121a4ed by Ben Gamari at 2024-02-23T06:40:55-05:00 Allow docstrings after exports Here we extend the parser and AST to preserve docstrings following export items. We then extend Haddock to parse `@since` annotations in such docstrings, allowing changes in export structure to be properly documented. Bumps haddock submodule. - - - - - 0eb2265d by Hécate Moonlight at 2024-02-24T16:02:16-05:00 Improve the synopsis and description of base - - - - - 2e36f5d2 by Jade at 2024-02-24T16:02:51-05:00 Error Messages: Properly align cyclic module error Fixes: #24476 - - - - - bbfb051c by Ben Gamari at 2024-02-24T19:10:23-05:00 Allow docstrings after exports Here we extend the parser and AST to preserve docstrings following export items. We then extend Haddock to parse `@since` annotations in such docstrings, allowing changes in export structure to be properly documented. - - - - - d8d6ad8c by Ben Gamari at 2024-02-24T19:10:23-05:00 ghc-internal: Move modules into GHC.Internal.* namespace Bumps haddock submodule due to testsuite output changes. - - - - - a82af7cd by Ben Gamari at 2024-02-24T19:10:23-05:00 ghc-internal: Rewrite `@since ` to `@since base-` These will be incrementally moved to the export sites in `base` where possible. - - - - - ca3836e1 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Migrate Haddock `not-home` pragmas from `ghc-internal` This ensures that we do not use `base` stub modules as declarations' homes when not appropriate. - - - - - c8cf3e26 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Partially freeze exports of GHC.Base Sadly there are still a few module reexports. However, at least we have decoupled from the exports of `GHC.Internal.Base`. - - - - - 272573c6 by Ben Gamari at 2024-02-24T19:10:23-05:00 Move Haddock named chunks - - - - - 2d8a881d by Ben Gamari at 2024-02-24T19:10:23-05:00 Drop GHC.Internal.Data.Int - - - - - 55c4c385 by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler: Fix mention to `GHC....` modules in wasm desugaring Really, these references should be via known-key names anyways. I have fixed the proximate issue here but have opened #24472 to track the additional needed refactoring. - - - - - 64150911 by Ben Gamari at 2024-02-24T19:10:23-05:00 Accept performance shifts from ghc-internal restructure As expected, Haddock now does more work. Less expected is that some other testcases actually get faster, presumably due to less interface file loading. As well, the size_hello_artifact test regressed a bit when debug information is enabled due to debug information for the new stub symbols. Metric Decrease: T12227 T13056 Metric Increase: haddock.Cabal haddock.base MultiLayerModulesTH_OneShot size_hello_artifact - - - - - 317a915b by Ben Gamari at 2024-02-24T19:10:23-05:00 Expose GHC.Wasm.Prim from ghc-experimental Previously this was only exposed from `ghc-internal` which violates our agreement that users shall not rely on things exposed from that package. Fixes #24479. - - - - - 3bbd2bf2 by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler/tc: Small optimisation of evCallStack Don't lookupIds unless we actually need them. - - - - - 3e5c9e3c by Ben Gamari at 2024-02-24T19:10:23-05:00 compiler/tc: Use toException instead of SomeException - - - - - 125714a6 by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Factor out errorBelch This was useful when debugging - - - - - 3d6aae7c by Ben Gamari at 2024-02-24T19:10:23-05:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - 6900306e by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Move PrimMVar to GHC.Internal.MVar - - - - - 28f8a148 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Move prettyCallStack to GHC.Internal.Stack - - - - - 4892de47 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Explicit dependency to workaround #24436 Currently `ghc -M` fails to account for `.hs-boot` files correctly, leading to issues with cross-package one-shot builds failing. This currently manifests in `GHC.Exception` due to the boot file for `GHC.Internal.Stack`. Work around this by adding an explicit `import`, ensuring that `GHC.Internal.Stack` is built before `GHC.Exception`. See #24436. - - - - - 294c93a5 by Ben Gamari at 2024-02-24T19:10:24-05:00 base: Use displayException in top-level exception handler Happily this also allows us to eliminate a special case for Deadlock exceptions. Implements [CLC #198](https://github.com/haskell/core-libraries-committee/issues/198). - - - - - cf756a25 by Ben Gamari at 2024-02-24T22:11:53-05:00 rts: Fix symbol references in Wasm RTS - - - - - 4e4d47a0 by Jade at 2024-02-26T15:17:20-05:00 GHCi: Improve response to unloading, loading and reloading modules Fixes #13869 - - - - - f3de8a3c by Zubin Duggal at 2024-02-26T15:17:57-05:00 rel-eng/fetch-gitlab.py: Fix name of aarch64 alpine 3_18 release job - - - - - c71bfdff by Cheng Shao at 2024-02-26T15:18:35-05:00 hadrian/hie-bios: pass -j to hadrian This commit passes -j to hadrian in the hadrian/hie-bios scripts. When the user starts HLS in a fresh clone that has just been configured, it takes quite a while for hie-bios to pick up the ghc flags and start actual indexing, due to the fact that the hadrian build step defaulted to -j1, so -j speeds things up and improve HLS user experience in GHC. Also add -j flag to .ghcid to speed up ghcid, and sets the Windows build root to .hie-bios which also works and unifies with other platforms, the previous build root _hie-bios was missing from .gitignore anyway. - - - - - 50bfdb46 by Cheng Shao at 2024-02-26T15:18:35-05:00 ci: enable parallelism in hadrian/ghci scripts This commit enables parallelism when the hadrian/ghci scripts are called in CI. The time bottleneck is in the hadrian build step, but previously the build step wasn't parallelized. - - - - - 61a78231 by Felix Yan at 2024-02-26T15:19:14-05:00 m4: Correctly detect GCC version When calling as `cc`, GCC does not outputs lowercased "gcc" at least in 13.2.1 version here. ``` $ cc --version cc (GCC) 13.2.1 20230801 ... ``` This fails the check and outputs the confusing message: `configure: $CC is not gcc; assuming it's a reasonably new C compiler` This patch makes it check for upper-cased "GCC" too so that it works correctly: ``` checking version of gcc... 13.2.1 ``` - - - - - 001aa539 by Teo Camarasu at 2024-02-27T13:26:46-05:00 Fix formatting in whereFrom docstring Previously it used markdown syntax rather than Haddock syntax for code quotes - - - - - e8034d15 by Teo Camarasu at 2024-02-27T13:26:46-05:00 Move ClosureType type to ghc-internal - Use ClosureType for InfoProv.ipDesc. - Use ClosureType for CloneStack.closureType. - Now ghc-heap re-exports this type from ghc-internal. See the accompanying CLC proposal: https://github.com/haskell/core-libraries-committee/issues/210 Resolves #22600 - - - - - 3da0a551 by Matthew Craven at 2024-02-27T13:27:22-05:00 StgToJS: Simplify ExprInline constructor of ExprResult Its payload was used only for a small optimization in genAlts, avoiding a few assignments for programs of this form: case NormalDataCon arg1 arg2 of x { NormalDataCon x1 x2 -> ... ; } But when compiling with optimizations, this sort of code is generally eliminated by case-of-known-constructor in Core-to-Core. So it doesn't seem worth tracking and cleaning up again in StgToJS. - - - - - 61bc92cc by Cheng Shao at 2024-02-27T16:58:42-05:00 rts: add missing ccs_mutex guard to internal_dlopen See added comment for details. Closes #24423. - - - - - dd29d3b2 by doyougnu at 2024-02-27T16:59:23-05:00 cg: Remove GHC.Cmm.DataFlow.Collections In pursuit of #15560 and #17957 and generally removing redundancy. - - - - - d3a050d2 by Cheng Shao at 2024-02-27T17:00:00-05:00 utils: remove unused lndir from tree Ever since the removal of the make build system, the in tree lndir hasn't been actually built, so this patch removes it. - - - - - 74b24a9b by Teo Camarasu at 2024-02-28T16:32:58+00:00 rts: avoid checking bdescr of value outside of Haskell heap In nonmovingTidyWeaks we want to check if the key of a weak pointer lives in the non-moving heap. We do this by checking the flags of the block the key lives in. But we need to be careful with values that live outside the Haskell heap, since they will lack a block descriptor and looking for one may lead to a segfault. In this case we should just accept that it isn't on the non-moving heap. Resolves #24492 - - - - - b4cae4ec by Simon Peyton Jones at 2024-02-29T02:10:08-05:00 In mkDataConRep, ensure the in-scope set is right A small change that fixes #24489 - - - - - 3836a110 by Cheng Shao at 2024-02-29T21:25:45-05:00 testsuite: fix T23540 fragility on 32-bit platforms T23540 is fragile on 32-bit platforms. The root cause is usage of `getEvidenceTreesAtPoint`, which internally relies on `Name`'s `Ord` instance, which is indeterministic. The solution is adding a deterministic `Ord` instance for `EvidenceInfo` and sorting the evidence trees before pretty printing. Fixes #24449. - - - - - 960c8d47 by Teo Camarasu at 2024-02-29T21:26:20-05:00 Reduce AtomicModifyIORef increment count This test leads to a lot of contention when N>2 and becomes very slow. Let's reduce the amount of work we do to compensate. Resolves #24490 - - - - - 2e46c8ad by Matthew Pickering at 2024-03-01T05:48:06-05:00 hadrian: Improve parallelism in binary-dist-dir rule I noticed that the "docs" target was needed after the libraries and executables were built. We can improve the parallelism by needing everything at once so that documentation can be built immediately after a library is built for example. - - - - - cb6c11fe by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: Bump windows and freebsd boot compilers to 9.6.4 We have previously bumped the docker images to use 9.6.4, but neglected to bump the windows images until now. - - - - - 30f06996 by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: darwin: Update to 9.6.2 for boot compiler 9.6.4 is currently broken due to #24050 Also update to use LLVM-15 rather than LLVM-11, which is out of date. - - - - - d9d69e12 by Matthew Pickering at 2024-03-01T05:48:07-05:00 Bump minimum bootstrap version to 9.6 - - - - - 67ace1c5 by Matthew Pickering at 2024-03-01T05:48:07-05:00 ci: Enable more documentation building Here we enable documentation building on 1. Darwin: The sphinx toolchain was already installed so we enable html and manpages. 2. Rocky8: Full documentation (toolchain already installed) 3. Alpine: Full documetnation (toolchain already installed) 4. Windows: HTML and manpages (toolchain already installed) Fixes #24465 - - - - - 39583c39 by Matthew Pickering at 2024-03-01T05:48:42-05:00 ci: Bump ci-images to allow updated aarch64-alpine image with llvm15 and clang15 - - - - - d91d00fc by Torsten Schmits at 2024-03-01T15:01:50-05:00 Introduce ListTuplePuns extension This implements Proposal 0475, introducing the `ListTuplePuns` extension which is enabled by default. Disabling this extension makes it invalid to refer to list, tuple and sum type constructors by using built-in syntax like `[Int]`, `(Int, Int)`, `(# Int#, Int# #)` or `(# Int | Int #)`. Instead, this syntax exclusively denotes data constructors for use with `DataKinds`. The conventional way of referring to these data constructors by prefixing them with a single quote (`'(Int, Int)`) is now a parser error. Tuple declarations have been moved to `GHC.Tuple.Prim` and the `Solo` data constructor has been renamed to `MkSolo` (in a previous commit). Unboxed tuples and sums now have real source declarations in `GHC.Types`. Unit and solo types for tuples are now called `Unit`, `Unit#`, `Solo` and `Solo#`. Constraint tuples now have the unambiguous type constructors `CTuple<n>` as well as `CUnit` and `CSolo`, defined in `GHC.Classes` like before. A new parser construct has been added for the unboxed sum data constructor declarations. The type families `Tuple`, `Sum#` etc. that were intended to provide nicer syntax have been omitted from this change set due to inference problems, to be implemented at a later time. See the MR discussion for more info. Updates the submodule utils/haddock. Updates the cabal submodule due to new language extension. Metric Increase: haddock.base Metric Decrease: MultiLayerModulesTH_OneShot size_hello_artifact Proposal document: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst Merge request: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8820 Tracking ticket: https://gitlab.haskell.org/ghc/ghc/-/issues/21294 - - - - - bbdb6286 by Sylvain Henry at 2024-03-01T15:01:50-05:00 JS linker: filter unboxed tuples - - - - - dec6d8d3 by Arnaud Spiwack at 2024-03-01T15:02:30-05:00 Improve error messages coming from non-linear patterns This enriched the `CtOrigin` for non-linear patterns to include data of the pattern that created the constraint (which can be quite useful if it occurs nested in a pattern) as well as an explanation why the pattern is non-restricted in (at least in some cases). - - - - - 6612388e by Arnaud Spiwack at 2024-03-01T15:02:30-05:00 Adjust documentation of linear lets according to committee decision - - - - - 1c064ef1 by Cheng Shao at 2024-03-02T17:11:19-05:00 compiler: start deprecating cmmToRawCmmHook cmmToRawCmmHook was added 4 years ago in d561c8f6244f8280a2483e8753c38e39d34c1f01. Its only user is the Asterius project, which has been archived and deprecated in favor of the ghc wasm backend. This patch starts deprecating cmmToRawCmmHook by placing a DEPRECATED pragma, and actual removal shall happen in a future GHC major release if no issue to oppose the deprecation has been raised in the meantime. - - - - - 9b74845f by Andrew Lelechenko at 2024-03-02T17:11:55-05:00 Data.List.NonEmpty.unzip: use WARNING with category instead of DEPRECATED CLC proposal: https://github.com/haskell/core-libraries-committee/issues/258 - - - - - 61bb5ff6 by Finley McIlwaine at 2024-03-04T09:01:40-08:00 add -fprof-late-overloaded and -fprof-late-overloaded-calls * Refactor late cost centre insertion for extensibility * Add two more late cost centre insertion methods that add SCCs to overloaded top level bindings and call sites with dictionary arguments. * Some tests for the basic functionality of the new insertion methods Resolves: #24500 - - - - - 82ccb801 by Andreas Klebinger at 2024-03-04T19:59:14-05:00 x86-ncg: Fix fma codegen when arguments are globals Fix a bug in the x86 ncg where results would be wrong when the desired output register and one of the input registers were the same global. Also adds a tiny optimization to make use of the memory addressing support when convenient. Fixes #24496 - - - - - 18ad1077 by Matthew Pickering at 2024-03-05T14:22:31-05:00 rel_eng: Update hackage docs upload scripts This adds the upload of ghc-internal and ghc-experimental to our scripts which upload packages to hackage. - - - - - bf47c9ba by Matthew Pickering at 2024-03-05T14:22:31-05:00 docs: Remove stray module comment from GHC.Profiling.Eras - - - - - 37d9b340 by Matthew Pickering at 2024-03-05T14:22:31-05:00 Fix ghc-internal cabal file The file mentioned some artifacts relating to the base library. I have renamed these to the new ghc-internal variants. - - - - - 23f2a478 by Matthew Pickering at 2024-03-05T14:22:31-05:00 Fix haddock source links and hyperlinked source There were a few issues with the hackage links: 1. We were using the package id rather than the package name for the package links. This is fixed by now allowing the template to mention %pkg% or %pkgid% and substituing both appropiatly. 2. The `--haddock-base-url` flag is renamed to `--haddock-for-hackage` as the new base link works on a local or remote hackage server. 3. The "src" path including too much stuff, so cross-package source links were broken as the template was getting double expanded. Fixes #24086 - - - - - 2fa336a9 by Ben Gamari at 2024-03-05T14:23:07-05:00 filepath: Bump submodule to 1.5.2.0 - - - - - 31217944 by Ben Gamari at 2024-03-05T14:23:07-05:00 os-string: Bump submodule to 2.0.2 - - - - - 4074a3f2 by Matthew Pickering at 2024-03-05T21:44:35-05:00 base: Reflect new era profiling RTS flags in GHC.RTS.Flags * -he profiling mode * -he profiling selector * --automatic-era-increment CLC proposal #254 - https://github.com/haskell/core-libraries-committee/issues/254 - - - - - a8c0e31b by Sylvain Henry at 2024-03-05T21:45:14-05:00 JS: faster implementation for some numeric primitives (#23597) Use faster implementations for the following primitives in the JS backend by not using JavaScript's BigInt: - plusInt64 - minusInt64 - minusWord64 - timesWord64 - timesInt64 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 21e3f325 by Cheng Shao at 2024-03-05T21:45:52-05:00 rts: add -xr option to control two step allocator reserved space size This patch adds a -xr RTS option to control the size of virtual memory address space reserved by the two step allocator on a 64-bit platform, see added documentation for explanation. Closes #24498. - - - - - dedcf102 by Cheng Shao at 2024-03-06T13:39:04-05:00 rts: expose HeapAlloc.h as public header This commit exposes HeapAlloc.h as a public header. The intention is to expose HEAP_ALLOCED/HEAP_ALLOCED_GC, so they can be used in assertions in other public headers, and they may also be useful for user code. - - - - - d19441d7 by Cheng Shao at 2024-03-06T13:39:04-05:00 rts: assert pointer is indeed heap allocated in Bdescr() This commit adds an assertion to Bdescr() to assert the pointer is indeed heap allocated. This is useful to rule out RTS bugs that attempt to access non-existent block descriptor of a static closure, #24492 being one such example. - - - - - 9a656a04 by Ben Gamari at 2024-03-06T13:39:39-05:00 ghc-experimental: Add dummy dependencies to work around #23942 This is a temporary measure to improve CI reliability until a proper solution is developed. Works around #23942. - - - - - 1e84b924 by Simon Peyton Jones at 2024-03-06T13:39:39-05:00 Three compile perf improvements with deep nesting These were changes are all triggered by #24471. 1. Make GHC.Core.Opt.SetLevels.lvlMFE behave better when there are many free variables. See Note [Large free-variable sets]. 2. Make GHC.Core.Opt.Arity.floatIn a bit lazier in its Cost argument. This benefits the common case where the ArityType turns out to be nullary. See Note [Care with nested expressions] 3. Make GHC.CoreToStg.Prep.cpeArg behave for deeply-nested expressions. See Note [Eta expansion of arguments in CorePrep] wrinkle (EA2). Compile times go down by up to 4.5%, and much more in artificial cases. (Geo mean of compiler/perf changes is -0.4%.) Metric Decrease: CoOpt_Read T10421 T12425 - - - - - c4b13113 by Hécate Moonlight at 2024-03-06T13:40:17-05:00 Use "module" instead of "library" when applicable in base haddocks - - - - - 9cd9efb4 by Vladislav Zavialov at 2024-03-07T13:01:54+03:00 Rephrase error message to say "visible arguments" (#24318) * Main change: make the error message generated by mkFunTysMsg more accurate by changing "value arguments" to "visible arguments". * Refactor: define a new type synonym VisArity and use it instead of Arity in a few places. It might be the case that there other places in the compiler that should talk about visible arguments rather than value arguments, but I haven't tried to find them all, focusing only on the error message reported in the ticket. - - - - - d523a6a7 by Ben Gamari at 2024-03-07T19:40:45-05:00 Bump array submodule - - - - - 7e55003c by Ben Gamari at 2024-03-07T19:40:45-05:00 Bump stm submodule - - - - - 32d337ef by Ben Gamari at 2024-03-07T19:40:45-05:00 Introduce exception context Here we introduce the `ExceptionContext` type and `ExceptionAnnotation` class, allowing dynamically-typed user-defined annotations to be attached to exceptions. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/199 GHC Proposal: https://github.com/ghc-proposals/ghc-proposals/pull/330 - - - - - 39f3d922 by Ben Gamari at 2024-03-07T19:40:46-05:00 testsuite/interface-stability: Update documentation - - - - - fdea7ada by Ben Gamari at 2024-03-07T19:40:46-05:00 ghc-internal: comment formatting - - - - - 4fba42ef by Ben Gamari at 2024-03-07T19:40:46-05:00 compiler: Default and warn ExceptionContext constraints - - - - - 3886a205 by Ben Gamari at 2024-03-07T19:40:46-05:00 base: Introduce exception backtraces Here we introduce the `Backtraces` type and associated machinery for attaching these via `ExceptionContext`. These has a few compile-time regressions (`T15703` and `T9872d`) due to the additional dependencies in the exception machinery. As well, there is a surprisingly large regression in the `size_hello_artifact` test. This appears to be due to various `Integer` and `Read` bits now being reachable at link-time. I believe it should be possible to avoid this but I have accepted the change for now to get the feature merged. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/199 GHC Proposal: https://github.com/ghc-proposals/ghc-proposals/pull/330 Metric Increase: T15703 T9872d size_hello_artifact - - - - - 18c5409f by Ben Gamari at 2024-03-07T19:40:46-05:00 users guide: Release notes for exception backtrace work - - - - - f849c5fc by Ben Gamari at 2024-03-07T19:40:46-05:00 compiler: Don't show ExceptionContext of GhcExceptions Most GhcExceptions are user-facing errors and therefore the ExceptionContext has little value. Ideally we would enable it in the DEBUG compiler but I am leaving this for future work. - - - - - dc646e6f by Sylvain Henry at 2024-03-07T19:40:46-05:00 Disable T9930fail for the JS target (cf #19174) - - - - - bfc09760 by Alan Zimmerman at 2024-03-07T19:41:22-05:00 Update showAstData to honour blanking of AnnParen Also tweak rendering of SrcSpan to remove extra blank line. - - - - - 50454a29 by Ben Gamari at 2024-03-08T03:32:42-05:00 ghc-internal: Eliminate GHC.Internal.Data.Kind This was simply reexporting things from `ghc-prim`. Instead reexport these directly from `Data.Kind`. Also add build ordering dependency to work around #23942. - - - - - 38a4b6ab by Ben Gamari at 2024-03-08T03:33:18-05:00 rts: Fix SET_HDR initialization of retainer set This fixes a regression in retainer set profiling introduced by b0293f78cb6acf2540389e22bdda420d0ab874da. Prior to that commit the heap traversal word would be initialized by `SET_HDR` using `LDV_RECORD_CREATE`. However, the commit added a `doingLDVProfiling` check in `LDV_RECORD_CREATE`, meaning that this initialization no longer happened. Given that this initialization was awkwardly indirectly anyways, I have fixed this by explicitly initializating the heap traversal word to `NULL` in `SET_PROF_HDR`. This is equivalent to the previous behavior, but much more direct. Fixes #24513. - - - - - 2859a637 by Ben Gamari at 2024-03-08T18:26:47-05:00 base: Use strerror_r instead of strerror As noted by #24344, `strerror` is not necessarily thread-safe. Thankfully, POSIX.1-2001 has long offered `strerror_r`, which is safe to use. Fixes #24344. CLC discussion: https://github.com/haskell/core-libraries-committee/issues/249 - - - - - edb9bf77 by Jade at 2024-03-09T03:39:38-05:00 Error messages: Improve Error messages for Data constructors in type signatures. This patch improves the error messages from invalid type signatures by trying to guess what the user did and suggesting an appropriate fix. Partially fixes: #17879 - - - - - cfb197e3 by Patrick at 2024-03-09T03:40:15-05:00 HieAst: add module name #24493 The main purpose of this is to tuck the module name `xxx` in `module xxx where` into the hieAst. It should fix #24493. The following have been done: 1. Renamed and update the `tcg_doc_hdr :: Maybe (LHsDoc GhcRn)` to `tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName))` To store the located module name information. 2. update the `RenamedSource` and `RenamedStuff` with extra `Maybe (XRec GhcRn ModuleName)` located module name information. 3. add test `testsuite/tests/hiefile/should_compile/T24493.hs` to ensure the module name is added and update several relevent tests. 4. accompanied submodule haddoc test update MR in https://gitlab.haskell.org/ghc/haddock/-/merge_requests/53 - - - - - 2341d81e by Vaibhav Sagar at 2024-03-09T03:40:54-05:00 GHC.Utils.Binary: fix a couple of typos - - - - - 5580e1bd by Ben Gamari at 2024-03-09T03:41:30-05:00 rts: Drop .wasm suffix from .prof file names This replicates the behavior on Windows, where `Hi.exe` will produce profiling output named `Hi.prof` instead of `Hi.exe.prof`. While in the area I also fixed the extension-stripping logic, which incorrectly rewrote `Hi.exefoo` to `Hi.foo`. Closes #24515. - - - - - 259495ee by Cheng Shao at 2024-03-09T03:41:30-05:00 testsuite: drop exe extension from .hp & .prof filenames See #24515 for details. - - - - - c477a8d2 by Ben Gamari at 2024-03-09T03:42:05-05:00 rts/linker: Enable GOT support on all platforms There is nothing platform-dependent about our GOT implementation and GOT support is needed by `T24171` on i386. - - - - - 2e592857 by Vladislav Zavialov at 2024-03-09T03:42:41-05:00 Drop outdated comment on TcRnIllformedTypePattern This should have been done in 0f0c53a501b but I missed it. - - - - - c554b4da by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/CloneStack: Bounds check array write - - - - - 15c590a5 by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/CloneStack: Don't expose helper functions in header - - - - - e831ce31 by Ben Gamari at 2024-03-09T09:39:20-05:00 base: Move internals of GHC.InfoProv into GHC.InfoProv.Types Such that we can add new helpers into GHC.InfoProv.Types without breakage. - - - - - 6948e24d by Ben Gamari at 2024-03-09T09:39:20-05:00 rts: Lazily decode IPE tables Previously we would eagerly allocate `InfoTableEnt`s for each info table registered in the info table provenance map. However, this costs considerable memory and initialization time. Instead we now lazily decode these tables. This allows us to use one-third the memory *and* opens the door to taking advantage of sharing opportunities within a module. This required considerable reworking since lookupIPE now must be passed its result buffer. - - - - - 9204a04e by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/IPE: Don't expose helper in header - - - - - 308926ff by Ben Gamari at 2024-03-09T09:39:20-05:00 rts/IPE: Share module_name within a Node This allows us to shave a 64-bit word off of the packed IPE entry size. - - - - - bebdea05 by Ben Gamari at 2024-03-09T09:39:20-05:00 IPE: Expose unit ID in InfoTableProv Here we add the unit ID to the info table provenance structure. - - - - - 6519c9ad by Ben Gamari at 2024-03-09T09:39:35-05:00 rts: Refactor GHC.Stack.CloneStack.decode Don't allocate a Ptr constructor per frame. - - - - - ed0b69dc by Ben Gamari at 2024-03-09T09:39:35-05:00 base: Do not expose whereFrom# from GHC.Exts - - - - - 2b1faea9 by Vladislav Zavialov at 2024-03-09T17:38:21-05:00 docs: Update info on TypeAbstractions * Mention TypeAbstractions in 9.10.1-notes.rst * Set the status to "Experimental". * Add a "Since: GHC 9.x" comment to each section. - - - - - f8b88918 by Ben Gamari at 2024-03-09T21:21:46-05:00 ci-images: Bump Alpine image to bootstrap with 9.8.2 - - - - - 705e6927 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Mark T24171 as fragile due to #24512 I will fix this but not in time for 9.10.1-alpha1 - - - - - c74196e1 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Mark linker_unload_native as fragile In particular this fails on platforms without `dlinfo`. I plan to address this but not before 9.10.1-alpha1. - - - - - f4d87f7a by Ben Gamari at 2024-03-09T21:21:46-05:00 configure: Bump version to 9.10 - - - - - 88df9a5f by Ben Gamari at 2024-03-09T21:21:46-05:00 Bump transformers submodule to 0.6.1.1 - - - - - 8176d5e8 by Ben Gamari at 2024-03-09T21:21:46-05:00 testsuite: Increase ulimit for T18623 1 MByte was just too tight and failed intermittently on some platforms (e.g. CentOS 7). Bumping the limit to 8 MByte should provide sufficient headroom. Fixes #23139. - - - - - c74b38a3 by Ben Gamari at 2024-03-09T21:21:46-05:00 base: Bump version to 4.20.0.0 - - - - - b2937fc3 by Ben Gamari at 2024-03-09T21:21:46-05:00 ghc-internal: Set initial version at 9.1001.0 This provides PVP compliance while maintaining a clear correspondence between GHC releases and `ghc-internal` versions. - - - - - 4ae7d868 by Ben Gamari at 2024-03-09T21:21:46-05:00 ghc-prim: Bump version to 0.11.0 - - - - - 50798dc6 by Ben Gamari at 2024-03-09T21:21:46-05:00 template-haskell: Bump version to 2.22.0.0 - - - - - 8564f976 by Ben Gamari at 2024-03-09T21:21:46-05:00 base-exports: Accommodate spurious whitespace changes in 32-bit output It appears that this was - - - - - 9d4f0e98 by Ben Gamari at 2024-03-09T21:21:46-05:00 users-guide: Move exception backtrace relnotes to 9.10 This was previously mistakenly added to the GHC 9.8 release notes. - - - - - 145eae60 by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/rel_eng: Fix name of Rocky8 artifact - - - - - 39c2a630 by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/rel_eng: Fix path of generate_jobs_metadata - - - - - aed034de by Ben Gamari at 2024-03-09T21:21:46-05:00 gitlab/upload: Rework recompression The old `combine` approach was quite fragile due to use of filename globbing. Moreover, it didn't parallelize well. This refactoring makes the goal more obvious, parallelizes better, and is more robust. - - - - - dc207d06 by Ben Gamari at 2024-03-10T08:56:08-04:00 configure: Bump GHC version to 9.11 Bumps haddock submodule. - - - - - 8b2513e8 by Ben Gamari at 2024-03-11T01:20:03-04:00 rts/linker: Don't unload code when profiling is enabled The heap census may contain references (e.g. `Counter.identity`) to static data which must be available when the census is reported at the end of execution. Fixes #24512. - - - - - 7810b4c3 by Ben Gamari at 2024-03-11T01:20:03-04:00 rts/linker: Don't unload native objects when dlinfo isn't available To do so is unsafe as we have no way of identifying references to symbols provided by the object. Fixes #24513. Fixes #23993. - - - - - 0590764c by Ben Gamari at 2024-03-11T01:20:39-04:00 rel_eng/upload: Purge both $rel_name/ and $ver/ This is necessary for prereleases, where GHCup accesses the release via `$ver/` - - - - - b85a4631 by Brandon Chinn at 2024-03-12T19:25:56-04:00 Remove duplicate code normalising slashes - - - - - c91946f9 by Brandon Chinn at 2024-03-12T19:25:56-04:00 Simplify regexes with raw strings - - - - - 1a5f53c6 by Brandon Chinn at 2024-03-12T19:25:57-04:00 Don't normalize backslashes in characters - - - - - 7ea971d3 by Andrei Borzenkov at 2024-03-12T19:26:32-04:00 Fix compiler crash caused by implicit RHS quantification in type synonyms (#24470) - - - - - 39f3ac3e by Cheng Shao at 2024-03-12T19:27:11-04:00 Revert "compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms" This reverts commit 615eb855416ce536e02ed935ecc5a6f25519ae16. It was originally intended to fix #24449, but it was merely sweeping the bug under the rug. 3836a110577b5c9343915fd96c1b2c64217e0082 has properly fixed the fragile test, and we no longer need the C version of genSym. Furthermore, the C implementation causes trouble when compiling with clang that targets i386 due to alignment warning and libatomic linking issue, so it makes sense to revert it. - - - - - e6bfb85c by Cheng Shao at 2024-03-12T19:27:11-04:00 compiler: fix out-of-bound memory access of genSym on 32-bit This commit fixes an unnoticed out-of-bound memory access of genSym on 32-bit. ghc_unique_inc is 32-bit sized/aligned on 32-bit platforms, but we mistakenly treat it as a Word64 pointer in genSym, and therefore will accidentally load 2 garbage higher bytes, or with a small but non-zero chance, overwrite something else in the data section depends on how the linker places the data segments. This regression was introduced in !11802 and fixed here. - - - - - 77171cd1 by Ben Orchard at 2024-03-14T09:00:40-04:00 Note mutability of array and address access primops Without an understanding of immutable vs. mutable memory, the index primop family have a potentially non-intuitive type signature: indexOffAddr :: Addr# -> Int# -> a readOffAddr :: Addr# -> Int# -> State# d -> (# State# d, a #) indexOffAddr# might seem like a free generality improvement, which it certainly is not! This change adds a brief note on mutability expectations for most index/read/write access primops. - - - - - 7da7f8f6 by Alan Zimmerman at 2024-03-14T09:01:15-04:00 EPA: Fix regression discarding comments in contexts Closes #24533 - - - - - 73be65ab by Fendor at 2024-03-19T01:42:53-04:00 Fix sharing of 'IfaceTyConInfo' during core to iface type translation During heap analysis, we noticed that during generation of 'mi_extra_decls' we have lots of duplicates for the instances: * `IfaceTyConInfo NotPromoted IfaceNormalTyCon` * `IfaceTyConInfo IsPromoted IfaceNormalTyCon` which should be shared instead of duplicated. This duplication increased the number of live bytes by around 200MB while loading the agda codebase into GHCi. These instances are created during `CoreToIface` translation, in particular `toIfaceTyCon`. The generated core looks like: toIfaceTyCon = \ tc_sjJw -> case $wtoIfaceTyCon tc_sjJw of { (# ww_sjJz, ww1_sjNL, ww2_sjNM #) -> IfaceTyCon ww_sjJz (IfaceTyConInfo ww1_sjNL ww2_sjNM) } whichs removes causes the sharing to work propery. Adding explicit sharing, with NOINLINE annotations, changes the core to: toIfaceTyCon = \ tc_sjJq -> case $wtoIfaceTyCon tc_sjJq of { (# ww_sjNB, ww1_sjNC #) -> IfaceTyCon ww_sjNB ww1_sjNC } which looks much more like sharing is happening. We confirmed via ghc-debug that all duplications were eliminated and the number of live bytes are noticeably reduced. - - - - - bd8209eb by Alan Zimmerman at 2024-03-19T01:43:28-04:00 EPA: Address more 9.10.1-alpha1 regressions from recent changes Closes #24533 Hopefully for good this time - - - - - 31bf85ee by Fendor at 2024-03-19T14:48:08-04:00 Escape multiple arguments in the settings file Uses responseFile syntax. The issue arises when GHC is installed on windows into a location that has a space, for example the user name is 'Fake User'. The $topdir will also contain a space, consequentially. When we resolve the top dir in the string `-I$topdir/mingw/include`, then `words` will turn this single argument into `-I/C/Users/Fake` and `User/.../mingw/include` which trips up the flag argument parser of various tools such as gcc or clang. We avoid this by escaping the $topdir before replacing it in `initSettngs`. Additionally, we allow to escape spaces and quotation marks for arguments in `settings` file. Add regression test case to count the number of options after variable expansion and argument escaping took place. Additionally, we check that escaped spaces and double quotation marks are correctly parsed. - - - - - f45f700e by Matthew Pickering at 2024-03-19T14:48:44-04:00 Read global package database from settings file Before this patch, the global package database was always assumed to be in libdir </> package.conf.d. This causes issues in GHC's build system because there are sometimes situations where the package database you need to use is not located in the same place as the settings file. * The stage1 compiler needs to use stage1 libraries, so we should set "Global Package DB" for the stage1 compiler to the stage1 package database. * Stage 2 cross compilers need to use stage2 libraries, so likewise, we should set the package database path to `_build/stage2/lib/` * The normal situation is where the stage2 compiler uses stage1 libraries. Then everything lines up. * When installing we have rearranged everything so that the settings file and package database line up properly, so then everything should continue to work as before. In this case we set the relative package db path to `package.conf.d`, so it resolves the same as before. * ghc-pkg needs to be modified as well to look in the settings file fo the package database rather than assuming the global package database location relative to the lib folder. * Cabal/cabal-install will work correctly because they query the global package database using `--print-global-package-db`. A reasonable question is why not generate the "right" settings files in the right places in GHC's build system. In order to do this you would need to engineer wrappers for all executables to point to a specific libdir. There are also situations where the same package db is used by two different compilers with two different settings files (think stage2 cross compiler and stage3 compiler). In short, this 10 line patch allows for some reasonable simplifications in Hadrian at very little cost to anything else. Fixes #24502 - - - - - 4c8f1794 by Matthew Pickering at 2024-03-19T14:48:44-04:00 hadrian: Remove stage1 testsuite wrappers logic Now instead of producing wrappers which pass the global package database argument to ghc and ghc-pkg, we write the location of the correct package database into the settings file so you can just use the intree compiler directly. - - - - - da0d8ba5 by Matthew Craven at 2024-03-19T14:49:20-04:00 Remove unused ghc-internal module "GHC.Internal.Constants" - - - - - b56d2761 by Matthew Craven at 2024-03-19T14:49:20-04:00 CorePrep: Rework lowering of BigNat# literals Don't use bigNatFromWord#, because that's terrible: * We shouldn't have to traverse a linked list at run-time to build a BigNat# literal. That's just silly! * The static List object we have to create is much larger than the actual BigNat#'s contents, bloating code size. * We have to read the corresponding interface file, which causes un-tracked implicit dependencies. (#23942) Instead, encode them into the appropriate platform-dependent sequence of bytes, and generate code that copies these bytes at run-time from an Addr# literal into a new ByteArray#. A ByteArray# literal would be the correct thing to generate, but these are not yet supported; see also #17747. Somewhat surprisingly, this change results in a slight reduction in compiler allocations, averaging around 0.5% on ghc's compiler performance tests, including when compiling programs that contain no bignum literals to begin with. The specific cause of this has not been investigated. Since this lowering no longer reads the interface file for GHC.Num.BigNat, the reasoning in Note [Depend on GHC.Num.Integer] is obsoleted. But the story of un-tracked built-in dependencies remains complex, and Note [Tracking dependencies on primitives] now exists to explain this complexity. Additionally, many empty imports have been modified to refer to this new note and comply with its guidance. Several empty imports necessary for other reasons have also been given brief explanations. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 349ea330 by Fendor at 2024-03-19T14:50:00-04:00 Eliminate thunk in 'IfaceTyCon' Heap analysis showed that `IfaceTyCon` retains a thunk to `IfaceTyConInfo`, defeating the sharing of the most common instances of `IfaceTyConInfo`. We make sure the indirection is removed by adding bang patterns to `IfaceTyCon`. Experimental results on the agda code base, where the `mi_extra_decls` were read from disk: Before this change, we observe around 8654045 instances of: `IfaceTyCon[Name,THUNK_1_0]` But these thunks almost exclusively point to a shared value! Forcing the thunk a little bit more, leads to `ghc-debug` reporting: `IfaceTyCon[Name:Name,IfaceTyConInfo]` and a noticeable reduction of live bytes (on agda ~10%). - - - - - 594bee0b by Krzysztof Gogolewski at 2024-03-19T14:50:36-04:00 Minor misc cleanups - GHC.HsToCore.Foreign.JavaScript: remove dropRuntimeRepArgs; boxed tuples don't take RuntimeRep args - GHC.HsToCore.Foreign.Call: avoid partial pattern matching - GHC.Stg.Unarise: strengthen the assertion; we can assert that non-rubbish literals are unary rather than just non-void - GHC.Tc.Gen.HsType: make sure the fsLit "literal" rule fires - users_guide/using-warnings.rst: remove -Wforall-identifier, now deprecated and does nothing - users_guide/using.rst: fix formatting - andy_cherry/test.T: remove expect_broken_for(23272...), 23272 is fixed The rest are simple cleanups. - - - - - cf55a54b by Ben Gamari at 2024-03-19T14:51:12-04:00 mk/relpath: Fix quoting Previously there were two instances in this script which lacked proper quoting. This resulted in `relpath` invocations in the binary distribution Makefile producing incorrect results on Windows, leading to confusing failures from `sed` and the production of empty package registrations. Fixes #24538. - - - - - 5ff88389 by Bryan Richter at 2024-03-19T14:51:48-04:00 testsuite: Disable T21336a on wasm - - - - - 60023351 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian/bindist: Eliminate extraneous `dirname` invocation Previously we would call `dirname` twice per installed library file. We now instead reuse this result. This helps appreciably on Windows, where processes are quite expensive. - - - - - 616ac300 by Ben Gamari at 2024-03-19T22:33:10-04:00 hadrian: Package mingw toolchain in expected location This fixes #24525, a regression due to 41cbaf44a6ab5eb9fa676d65d32df8377898dc89. Specifically, GHC expects to find the mingw32 toolchain in the binary distribution root. However, after this patch it was packaged in the `lib/` directory. - - - - - de9daade by Ben Gamari at 2024-03-19T22:33:11-04:00 gitlab/rel_eng: More upload.sh tweaks - - - - - 1dfe12db by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_eng: Drop dead prepare_docs codepath - - - - - dd2d748b by Ben Gamari at 2024-03-19T22:33:11-04:00 rel_env/recompress_all: unxz before recompressing Previously we would rather compress the xz *again*, before in addition compressing it with the desired scheme. Fixes #24545. - - - - - 9d936c57 by Ben Gamari at 2024-03-19T22:33:11-04:00 mk-ghcup-metadata: Fix directory of testsuite tarball As reported in #24546, the `dlTest` artifact should be extracted into the `testsuite` directory. - - - - - 6d398066 by Ben Gamari at 2024-03-19T22:33:11-04:00 ghcup-metadata: Don't populate dlOutput unless necessary ghcup can apparently infer the output name of an artifact from its URL. Consequently, we should only include the `dlOutput` field when it would differ from the filename of `dlUri`. Fixes #24547. - - - - - 576f8b7e by Zubin Duggal at 2024-03-19T22:33:46-04:00 Revert "Apply shellcheck suggestion to SUBST_TOOLDIR" This reverts commit c82770f57977a2b5add6e1378f234f8dd6153392. The shellcheck suggestion is spurious and results in SUBST_TOOLDIR being a no-op. `set` sets positional arguments for bash, but we want to set the variable given as the first autoconf argument. Fixes #24542 Metric decreases because the paths in the settings file are now shorter, so we allocate less when we read the settings file. ------------------------- Metric Decrease: T12425 T13035 T9198 ------------------------- - - - - - cdfe6e01 by Fendor at 2024-03-19T22:34:22-04:00 Compact serialisation of IfaceAppArgs In #24563, we identified that IfaceAppArgs serialisation tags each cons cell element with a discriminator byte. These bytes add up quickly, blowing up interface files considerably when '-fwrite-if-simplified-core' is enabled. We compact the serialisation by writing out the length of 'IfaceAppArgs', followed by serialising the elements directly without any discriminator byte. This improvement can decrease the size of some interface files by up to 35%. - - - - - 97a2bb1c by Simon Peyton Jones at 2024-03-20T17:11:29+00:00 Expand untyped splices in tcPolyExprCheck Fixes #24559 - - - - - 5f275176 by Alan Zimmerman at 2024-03-20T22:44:12-04:00 EPA: Clean up Exactprint helper functions a bit - Introduce a helper lens to compose on `EpAnn a` vs `a` versions - Rename some prime versions of functions back to non-prime They were renamed during the rework - - - - - da2a10ce by Vladislav Zavialov at 2024-03-20T22:44:48-04:00 Type operators in promoteOccName (#24570) Type operators differ from term operators in that they are lexically classified as (type) constructors, not as (type) variables. Prior to this change, promoteOccName did not account for this difference, causing a scoping issue that affected RequiredTypeArguments. type (!@#) = Bool f = idee (!@#) -- Not in scope: ‘!@#’ (BUG) Now we have a special case in promoteOccName to account for this. - - - - - 247fc0fa by Preetham Gujjula at 2024-03-21T10:19:18-04:00 docs: Remove mention of non-existent Ord instance for Complex The documentation for Data.Complex says that the Ord instance for Complex Float is deficient, but there is no Ord instance for Complex a. The Eq instance for Complex Float is similarly deficient, so we use that as an example instead. - - - - - 6fafc51e by Andrei Borzenkov at 2024-03-21T10:19:54-04:00 Fix TH handling in `pat_to_type_pat` function (#24571) There was missing case for `SplicePat` in `pat_to_type_at` function, hence patterns with splicing that checked against `forall->` doesn't work properly because they fall into the "illegal pattern" case. Code example that is now accepted: g :: forall a -> () g $([p| a |]) = () - - - - - 52072f8e by Sylvain Henry at 2024-03-21T21:01:59-04:00 Type-check default declarations before deriving clauses (#24566) See added Note and #24566. Default declarations must be type-checked before deriving clauses. - - - - - 7dfdf3d9 by Sylvain Henry at 2024-03-21T21:02:40-04:00 Lexer: small perf changes - Use unsafeChr because we know our values to be valid - Remove some unnecessary use of `ord` (return Word8 values directly) - - - - - 864922ef by Sylvain Henry at 2024-03-21T21:02:40-04:00 JS: fix some comments - - - - - 3e0b2b1f by Sebastian Graf at 2024-03-21T21:03:16-04:00 Simplifier: Re-do dependency analysis in abstractFloats (#24551) In #24551, we abstracted a string literal binding over a type variable, triggering a CoreLint error when that binding floated to top-level. The solution implemented in this patch fixes this by re-doing dependency analysis on a simplified recursive let binding that is about to be type abstracted, in order to find the minimal set of type variables to abstract over. See wrinkle (AB5) of Note [Floating and type abstraction] for more details. Fixes #24551 - - - - - 8a8ac65a by Matthew Craven at 2024-03-23T00:20:52-04:00 Improve toInteger @Word32 on 64-bit platforms On 64-bit platforms, every Word32 fits in an Int, so we can convert to Int# without having to perform the overflow check integerFromWord# uses internally. - - - - - 0c48f2b9 by Apoorv Ingle at 2024-03-23T00:21:28-04:00 Fix for #24552 (see testcase T24552) Fixes for a bug in desugaring pattern synonyms matches, introduced while working on on expanding `do`-blocks in #18324 The `matchWrapper` unecessarily (and incorrectly) filtered out the default wild patterns in a match. Now the wild pattern alternative is simply ignored by the pm check as its origin is `Generated`. The current code now matches the expected semantics according to the language spec. - - - - - b72705e9 by Simon Peyton Jones at 2024-03-23T00:22:04-04:00 Print more info about kinds in error messages This fixes #24553, where GHC unhelpfully said error: [GHC-83865] • Expected kind ‘* -> * -> *’, but ‘Foo’ has kind ‘* -> * -> *’ See Note [Showing invisible bits of types in error messages] - - - - - 8f7cfc7e by Tristan Cacqueray at 2024-03-23T00:22:44-04:00 docs: remove the don't use float hint This hint is outdated, ``Complex Float`` are now specialised, and the heap space suggestion needs more nuance so it should be explained in the unboxed/storable array documentation. - - - - - 5bd8ed53 by Andreas Klebinger at 2024-03-23T16:18:33-04:00 NCG: Fix a bug in jump shortcutting. When checking if a jump has more than one destination account for the possibility of some jumps not being representable by a BlockId. We do so by having isJumpishInstr return a `Maybe BlockId` where Nothing represents non-BlockId jump destinations. Fixes #24507 - - - - - 8d67f247 by Ben Gamari at 2024-03-23T16:19:09-04:00 docs: Drop old release notes, add for 9.12.1 - - - - - 7db8c992 by Cheng Shao at 2024-03-25T13:45:46-04:00 rts: fix clang compilation on aarch64 This patch fixes function prototypes in ARMOutlineAtomicsSymbols.h which causes "error: address argument to atomic operation must be a pointer to _Atomic type" when compiling with clang on aarch64. - - - - - 237194ce by Sylvain Henry at 2024-03-25T13:46:27-04:00 Lexer: fix imports for Alex 3.5.1 (#24583) - - - - - 810660b7 by Cheng Shao at 2024-03-25T22:19:16-04:00 libffi-tarballs: bump libffi-tarballs submodule to libffi 3.4.6 This commit bumps the libffi-tarballs submodule to libffi 3.4.6, which includes numerous upstream libffi fixes, especially https://github.com/libffi/libffi/issues/760. - - - - - d2ba41e8 by Alan Zimmerman at 2024-03-25T22:19:51-04:00 EPA: do not duplicate comments in signature RHS - - - - - 32a8103f by Rodrigo Mesquita at 2024-03-26T21:16:12-04:00 configure: Use LDFLAGS when trying linkers A user may configure `LDFLAGS` but not `LD`. When choosing a linker, we will prefer `ldd`, then `ld.gold`, then `ld.bfd` -- however, we have to check for a working linker. If either of these fail, we try the next in line. However, we were not considering the `$LDFLAGS` when checking if these linkers worked. So we would pick a linker that does not support the current $LDFLAGS and fail further down the line when we used that linker with those flags. Fixes #24565, where `LDFLAGS=-Wl,-z,pack-relative-relocs` is not supported by `ld.gold` but that was being picked still. - - - - - bf65a7c3 by Rodrigo Mesquita at 2024-03-26T21:16:48-04:00 bindist: Clean xattrs of bin and lib at configure time For issue #21506, we started cleaning the extended attributes of binaries and libraries from the bindist *after* they were installed to workaround notarisation (#17418), as part of `make install`. However, the `ghc-toolchain` binary that is now shipped with the bindist must be run at `./configure` time. Since we only cleaned the xattributes of the binaries and libs after they were installed, in some situations users would be unable to run `ghc-toolchain` from the bindist, failing at configure time (#24554). In this commit we move the xattr cleaning logic to the configure script. Fixes #24554 - - - - - cfeb70d3 by Rodrigo Mesquita at 2024-03-26T21:17:24-04:00 Revert "NCG: Fix a bug in jump shortcutting." This reverts commit 5bd8ed53dcefe10b72acb5729789e19ceb22df66. Fixes #24586 - - - - - 13223f6d by Serge S. Gulin at 2024-03-27T07:28:51-04:00 JS: `h$rts_isProfiled` is removed from `profiling` and left its version at `rts/js/config.js` - - - - - 0acfe391 by Alan Zimmerman at 2024-03-27T07:29:27-04:00 EPA: Do not extend declaration range for trailine zero len semi The lexer inserts virtual semicolons having zero width. Do not use them to extend the list span of items in a list. - - - - - cd0fb82f by Alan Zimmerman at 2024-03-27T19:33:08+00:00 EPA: Fix FamDecl range The span was incorrect if opt_datafam_kind_sig was empty - - - - - f8f384a8 by Ben Gamari at 2024-03-29T01:23:03-04:00 Fix type of _get_osfhandle foreign import Fixes #24601. - - - - - 00d3ecf0 by Alan Zimmerman at 2024-03-29T12:19:10+00:00 EPA: Extend StringLiteral range to include trailing commas This goes slightly against the exact printing philosophy where trailing decorations should be in an annotation, but the practicalities of adding it to the WarningTxt environment, and the problems caused by deviating do not make a more principles approach worthwhile. - - - - - efab3649 by brandon s allbery kf8nh at 2024-03-31T20:04:01-04:00 clarify Note [Preproccesing invocations] - - - - - c8a4c050 by Ben Gamari at 2024-04-02T12:50:35-04:00 rts: Fix TSAN_ENABLED CPP guard This should be `#if defined(TSAN_ENABLED)`, not `#if TSAN_ENABLED`, lest we suffer warnings. - - - - - e91dad93 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix errors when compiling with TSAN This commit fixes rts compilation errors when compiling with TSAN: - xxx_FENCE macros are redefined and trigger CPP warnings. - Use SIZEOF_W. WORD_SIZE_IN_BITS is provided by MachDeps.h which Cmm.h doesn't include by default. - - - - - a9ab9455 by Cheng Shao at 2024-04-02T12:50:35-04:00 rts: fix clang-specific errors when compiling with TSAN This commit fixes clang-specific rts compilation errors when compiling with TSAN: - clang doesn't have -Wtsan flag - Fix prototype of ghc_tsan_* helper functions - __tsan_atomic_* functions aren't clang built-ins and sanitizer/tsan_interface_atomic.h needs to be included - On macOS, TSAN runtime library is libclang_rt.tsan_osx_dynamic.dylib, not libtsan. -fsanitize-thread as a link-time flag will take care of linking the TSAN runtime library anyway so remove tsan as an rts extra library - - - - - 865bd717 by Cheng Shao at 2024-04-02T12:50:35-04:00 compiler: fix github link to __tsan_memory_order in a comment - - - - - 07cb627c by Cheng Shao at 2024-04-02T12:50:35-04:00 ci: improve TSAN CI jobs - Run TSAN jobs with +thread_sanitizer_cmm which enables Cmm instrumentation as well. - Run TSAN jobs in deb12 which ships gcc-12, a reasonably recent gcc that @bgamari confirms he's using in #GHC:matrix.org. Ideally we should be using latest clang release for latest improvements in sanitizers, though that's left as future work. - Mark TSAN jobs as manual+allow_failure in validate pipelines. The purpose is to demonstrate that we have indeed at least fixed building of TSAN mode in CI without blocking the patch to land, and once merged other people can begin playing with TSAN using their own dev setups and feature branches. - - - - - a1c18c7b by Andrei Borzenkov at 2024-04-02T12:51:11-04:00 Merge tc_infer_hs_type and tc_hs_type into one function using ExpType philosophy (#24299, #23639) This patch implements refactoring which is a prerequisite to updating kind checking of type patterns. This is a huge simplification of the main worker that checks kind of HsType. It also fixes the issues caused by previous code duplication, e.g. that we didn't add module finalizers from splices in inference mode. - - - - - 817e8936 by Rodrigo Mesquita at 2024-04-02T20:13:05-04:00 th: Hide the Language.Haskell.TH.Lib.Internal module from haddock Fixes #24562 - - - - - b36ee57b by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: reenable h$appendToHsString optimization (#24495) The optimization introducing h$appendToHsString wasn't kicking in anymore (while it did in 9.8.1) because of the changes introduced in #23270 (7e0c8b3bab30). This patch reenables the optimization by matching on case-expression, as done in Cmm for unpackCString# standard thunks. The test is also T24495 added in the next commits (two commits for ease of backporting to 9.8). - - - - - 527616e9 by Sylvain Henry at 2024-04-02T20:13:46-04:00 JS: fix h$appendToHsString implementation (#24495) h$appendToHsString needs to wrap its argument in an updatable thunk to behave like unpackAppendCString#. Otherwise if a SingleEntry thunk is passed, it is stored as-is in a CONS cell, making the resulting list impossible to deepseq (forcing the thunk doesn't update the contents of the CONS cell)! The added test checks that the optimization kicks in and that h$appendToHsString works as intended. Fix #24495 - - - - - faa30b41 by Simon Peyton Jones at 2024-04-02T20:14:22-04:00 Deal with duplicate tyvars in type declarations GHC was outright crashing before this fix: #24604 - - - - - e0b0c717 by Simon Peyton Jones at 2024-04-02T20:14:58-04:00 Try using MCoercion in exprIsConApp_maybe This is just a simple refactor that makes exprIsConApp_maybe a little bit more direct, simple, and efficient. Metrics: compile_time/bytes allocated geo. mean -0.1% minimum -2.0% maximum -0.0% Not a big gain, but worthwhile given that the code is, if anything, easier to grok. - - - - - 15f4d867 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Initial ./configure support for selecting I/O managers In this patch we just define new CPP vars, but don't yet use them or replace the existing approach. That will follow. The intention here is that every I/O manager can be enabled/disabled at GHC build time (subject to some constraints). More than one I/O manager can be enabled to be built. At least one I/O manager supporting the non-threaded RTS must be enabled as well as at least one supporting the non-threaded RTS. The I/O managers enabled here will become the choices available at runtime at RTS startup (in later patches). The choice can be made with RTS flags. There are separate sets of choices for the threaded and non-threaded RTS ways, because most I/O managers are specific to these ways. Furthermore we must establish a default I/O manager for the threaded and non-threaded RTS. Most I/O managers are platform-specific so there are checks to ensure each one can be enabled on the platform. Such checks are also where (in future) any system dependencies (e.g. libraries) can be checked. The output is a set of CPP flags (in the mk/config.h file), with one flag per named I/O manager: * IOMGR_BUILD_<name> : which ones should be built (some) * IOMGR_DEFAULT_NON_THREADED_<name> : which one is default (exactly one) * IOMGR_DEFAULT_THREADED_<name> : which one is default (exactly one) and a set of derived flags in IOManager.h * IOMGR_ENABLED_<name> : enabled for the current RTS way Note that IOMGR_BUILD_<name> just says that an I/O manager will be built for _some_ RTS way (i.e. threaded or non-threaded). The derived flags IOMGR_ENABLED_<name> in IOManager.h say if each I/O manager is enabled in the "current" RTS way. These are the ones that can be used for conditional compilation of the I/O manager code. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - 85b0f87a by Duncan Coutts at 2024-04-03T01:27:17-04:00 Change the handling of the RTS flag --io-manager= Now instead of it being just used on Windows to select between the WinIO vs the MIO or Win32-legacy I/O managers, it is now used on all platforms for selecting the I/O manager to use. Right now it remains the case that there is only an actual choice on Windows, but that will change later. Document the --io-manager flag in the user guide. This change is also reflected in the RTS flags types in the base library. Deprecate the export of IoSubSystem from GHC.RTS.Flags with a message to import it from GHC.IO.Subsystem. The way the 'IoSubSystem' is detected also changes. Instead of looking at the RTS flag, there is now a C bool global var in the RTS which gets set on startup when the I/O manager is selected. This bool var says whether the selected I/O manager classifies as "native" on Windows, which in practice means the WinIO I/O manager has been selected. Similarly, the is_io_mng_native_p RTS helper function is re-implemented in terms of the selected I/O manager, rather than based on the RTS flags. We do however remove the ./configure --native-io-manager flag because we're bringing the WinIO/MIO/Win32-legacy choice under the new general scheme for selecting I/O managers, and that new scheme involves no ./configure time user choices, just runtime RTS flag choices. - - - - - 1a8f020f by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert {init,stop,exit}IOManager to switch style Rather than ad-hoc cpp conitionals on THREADED_RTS and mingw32_HOST_OS, we use a style where we switch on the I/O manager impl, with cases for each I/O manager impl. - - - - - a5bad3d2 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Split up the CapIOManager content by I/O manager Using the new IOMGR_ENABLED_<name> CPP defines. - - - - - 1d36e609 by Duncan Coutts at 2024-04-03T01:27:17-04:00 Convert initIOManagerAfterFork and wakeupIOManager to switch style - - - - - c2f26f36 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of waitRead#/Write# from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. - - - - - 457705a8 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move most of the delay# impl from cmm to C Moves it into the IOManager.c where we can follow the new pattern of switching on the selected I/O manager. Uses a new IOManager API: syncDelay, following the naming convention of sync* for thread-synchronous I/O & timer/delay operations. As part of porting from cmm to C, we maintain the rule that the why_blocked gets accessed using load acquire and store release atomic memory operations. There was one exception to this rule: in the delay# primop cmm code on posix (not win32), the why_blocked was being updated using a store relaxed, not a store release. I've no idea why. In this convesion I'm playing it safe here and using store release consistently. - - - - - e93058e0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 insertIntoSleepingQueue is no longer public No longer defined in IOManager.h, just a private function in IOManager.c. Since it is no longer called from cmm code, just from syncDelay. It ought to get moved further into the select() I/O manager impl, rather than living in IOManager.c. On the other hand appendToIOBlockedQueue is still called from cmm code in the win32-legacy I/O manager primops async{Read,Write}#, and it is also used by the select() I/O manager. Update the CPP and comments to reflect this. - - - - - 60ce9910 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move anyPendingTimeoutsOrIO impl from .h to .c The implementation is eventually going to need to use more private things, which will drag in unwanted includes into IOManager.h, so it's better to move the impl out of the header file and into the .c file, at the slight cost of it no longer being inline. At the same time, change to the "switch (iomgr_type)" style. - - - - - f70b8108 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Take a simpler approach to gcc warnings in IOManager.c We have lots of functions with conditional implementations for different I/O managers. Some functions, for some I/O managers, naturally have implementations that do nothing or barf. When only one such I/O manager is enabled then the whole function implementation will have an implementation that does nothing or barfs. This then results in warnings from gcc that parameters are unused, or that the function should be marked with attribute noreturn (since barf does not return). The USED_IF_THREADS trick for fine-grained warning supression is fine for just two cases, but an equivalent here would need USED_IF_THE_ONLY_ENABLED_IOMGR_IS_X_OR_Y which would have combinitorial blowup. So we take a coarse grained approach and simply disable these two warnings for the whole file. So we use a GCC pragma, with its handy push/pop support: #pragma GCC diagnostic push #pragma GCC diagnostic ignored "-Wsuggest-attribute=noreturn" #pragma GCC diagnostic ignored "-Wunused-parameter" ... #pragma GCC diagnostic pop - - - - - b48805b9 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add a new trace class for the iomanager It makes sense now for it to be separate from the scheduler class of tracers. Enabled with +RTS -Do. Document the -Do debug flag in the user guide. - - - - - f0c1f862 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Have the throwTo impl go via (new) IOManager APIs rather than directly operating on the IO manager's data structures. Specifically, when thowing an async exception to a thread that is blocked waiting for I/O or waiting for a timer, then we want to cancel that I/O waiting or cancel the timer. Currently this is done directly in removeFromQueues() in RaiseAsync.c. We want it to go via proper APIs both for modularity but also to let us support multiple I/O managers. So add sync{IO,Delay}Cancel, which is the cancellation for the corresponding sync{IO,Delay}. The implementations of these use the usual "switch (iomgr_type)" style. - - - - - 4f9e9c4e by Duncan Coutts at 2024-04-03T01:27:18-04:00 Move awaitEvent into a proper IOManager API and have the scheduler use it. Previously the scheduler calls awaitEvent directly, and awaitEvent is implemented directly in the RTS I/O managers (select, win32). This relies on the old scheme where there's a single active I/O manager for each platform and RTS way. We want to move that to go via an API in IOManager.{h,c} which can then call out to the active I/O manager. Also take the opportunity to split awaitEvent into two. The existing awaitEvent has a bool wait parameter, to say if the call should be blocking or non-blocking. We split this into two separate functions: pollCompletedTimeoutsOrIO and awaitCompletedTimeoutsOrIO. We split them for a few reasons: they have different post-conditions (specifically the await version is supposed to guarantee that there are threads runnable when it completes). Secondly, it is also anticipated that in future I/O managers the implementations of the two cases will be simpler if they are separated. - - - - - 5ad4b30f by Duncan Coutts at 2024-04-03T01:27:18-04:00 Rename awaitEvent in select and win32 I/O managers These are now just called from IOManager.c and are the per-I/O manager backend impls (whereas previously awaitEvent was the entry point). Follow the new naming convention in the IOManager.{h,c} of awaitCompletedTimeoutsOrIO, with the I/O manager's name as a suffix: so awaitCompletedTimeoutsOrIO{Select,Win32}. - - - - - d30c6bc6 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Tidy up a couple things in Select.{h,c} Use the standard #include {Begin,End}Private.h style rather than RTS_PRIVATE on individual decls. And conditionally build the code for the select I/O manager based on the new CPP IOMGR_ENABLED_SELECT rather than on THREADED_RTS. - - - - - 4161f516 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add an IOManager API for scavenging TSO blocked_info When the GC scavenges a TSO it needs to scavenge the tso->blocked_info but the blocked_info is a big union and what lives there depends on the two->why_blocked, which for I/O-related reasons is something that in principle is the responsibility of the I/O manager and not the GC. So the right thing to do is for the GC to ask the I/O manager to sscavenge the blocked_info if it encounters any I/O-related why_blocked reasons. So we add scavengeTSOIOManager in IOManager.{h,c} with the usual style. Now as it happens, right now, there is no special scavenging to do, so the implementation of scavengeTSOIOManager is a fancy no-op. That's because the select I/O manager uses only the fd and target members, which are not GC pointers, and the win32-legacy I/O manager _ought_ to be using GC-managed heap objects for the StgAsyncIOResult but it is actually usingthe C heap, so again no GC pointers. If the win32-legacy were doing this more sensibly, then scavengeTSOIOManager would be the right place to do the GC magic. Future I/O managers will need GC heap objects in the tso->blocked_info and will make use of this functionality. - - - - - 94a87d21 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add I/O manager API notifyIOManagerCapabilitiesChanged Used in setNumCapabilities. It only does anything for MIO on Posix. Previously it always invoked Haskell code, but that code only did anything on non-Windows (and non-JS), and only threaded. That currently effectively means the MIO I/O manager on Posix. So now it only invokes it for the MIO Posix case. - - - - - 3be6d591 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Select an I/O manager early in RTS startup We need to select the I/O manager to use during startup before the per-cap I/O manager initialisation. - - - - - aaa294d0 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Make struct CapIOManager be fully opaque Provide an opaque (forward) definition in Capability.h (since the cap contains a *CapIOManager) and then only provide a full definition in a new file IOManagerInternals.h. This new file is only supposed to be included by the IOManager implementation, not by its users. So that means IOManager.c and individual I/O manager implementations. The posix/Signals.c still needs direct access, but that should be eliminated. Anything that needs direct access either needs to be clearly part of an I/O manager (e.g. the sleect() one) or go via a proper API. - - - - - 877a2a80 by Duncan Coutts at 2024-04-03T01:27:18-04:00 The select() I/O manager does have some global initialisation It's just to make sure an exception CAF is a GC root. - - - - - 9c51473b by Duncan Coutts at 2024-04-03T01:27:18-04:00 Add tracing for the main I/O manager actions Using the new tracer class. Note: The unconditional definition of showIOManager should be compatible with the debugTrace change in 7c7d1f6. Co-authored-by: Pi Delport <pi at well-typed.com> - - - - - c7d3e3a3 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Include the default I/O manager in the +RTS --info output Document the extra +RTS --info output in the user guide - - - - - 8023bad4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 waitRead# / waitWrite# do not work for win32-legacy I/O manager Previously it was unclear that they did not work because the code path was shared with other I/O managers (in particular select()). Following the code carefully shows that what actually happens is that the calling thread would block forever: the thread will be put into the blocked queue, but no other action is scheduled that will ever result in it getting unblocked. It's better to just fail loudly in case anyone accidentally calls it, also it's less confusing code. - - - - - 83a74d20 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Conditionally ignore some GCC warnings Some GCC versions don't know about some warnings, and they complain that we're ignoring unknown warnings. So we try to ignore the warning based on the GCC version. - - - - - 1adc6fa4 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept changes to base-exports All the changes are in fact not changes at all. Previously, the IoSubSystem data type was defined in GHC.RTS.Flags and exported from both GHC.RTS.Flags and GHC.IO.SubSystem. Now, the data type is defined in GHC.IO.SubSystem and still exported from both modules. Therefore, the same exports and same instances are still available from both modules. But the base-exports records only the defining module, and so it looks like a change when it is fully compatible. Related: we do add a deprecation to the export of the type via GHC.RTS.Flags, telling people to use the export from GHC.IO.SubSystem. Also the sort order for some unrelated Show instances changed. No idea why. The same changes apply in the other versions, with a few more changes due to sort order weirdness. - - - - - 8d950968 by Duncan Coutts at 2024-04-03T01:27:18-04:00 Accept metric decrease in T12227 I can't think of any good reason that anything in this MR should have changed the number of allocations, up or down. (Yes this is an empty commit.) Metric Decrease: T12227 - - - - - e869605e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 1efd0714 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 FloatOut: improve floating for join point See the new Note [Floating join point bindings]. * Completely get rid of the complicated join_ceiling nonsense, which I have never understood. * Do not float join points at all, except perhaps to top level. * Some refactoring around wantToFloat, to treat Rec and NonRec more uniformly - - - - - 9c00154d by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve eta-expansion through call stacks See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity This is a one-line change, that fixes an inconsistency - || isCallStackPredTy ty + || isCallStackPredTy ty || isCallStackTy ty - - - - - 95a9a172 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Spelling, layout, pretty-printing only - - - - - bdf1660f by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Improve exprIsConApp_maybe a little Eliminate a redundant case at birth. This sometimes reduces Simplifier iterations. See Note [Case elim in exprIsConApp_maybe]. - - - - - 609cd32c by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Inline GHC.HsToCore.Pmc.Solver.Types.trvVarInfo When exploring compile-time regressions after meddling with the Simplifier, I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I just added an INLINE pragma to it; no sense in depending on a delicately-balanced fluke. - - - - - ae24c9bc by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Slight improvement in WorkWrap Ensure that WorkWrap preserves lambda binders, in case of join points. Sadly I have forgotten why I made this change (it was while I was doing a lot of meddling in the Simplifier, but * it does no harm, * it is slightly more efficient, and * presumably it made something better! Anyway I have kept it in a separate commit. - - - - - e9297181 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Use named record fields for the CastIt { ... } data constructor This is a pure refactor - - - - - b4581e23 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Remove a long-commented-out line Pure refactoring - - - - - e026bdf2 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The main changes are below. There are also many new or rewritten Notes. Avoiding simplifying repeatedly ~~~~~~~~~~~~~~~ See Note [Avoiding simplifying repeatedly] * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env. Currently used only for the next point: avoiding repeatedly simplifying coercions. * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * Improve the case-merge transformation: - Move the main code to `GHC.Core.Utils.mergeCaseAlts`, to join `filterAlts` and friends. See Note [Merge Nested Cases] in GHC.Core.Utils. - Add a new case for `tagToEnum#`; see wrinkle (MC3). - Add a new case to look through join points: see wrinkle (MC4) postInlineUnconditionally ~~~~~~~~~~~~~~~~~~~~~~~~~ * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. * Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. * Improve occurrence analyis for bottoming function calls, to help postInlineUnconditionally. See Note [Bottoming function calls] in GHC.Core.Opt.OccurAnal Inlining generally ~~~~~~~~~~~~~~~~~~ * In GHC.Core.Opt.Simplify.Utils.interestingCallContext, use RhsCtxt NonRecursive (not BoringCtxt) for a plain-seq case. See Note [Seq is boring] Also, wrinkle (SB1), inline in that `seq` context only for INLINE functions (UnfWhen guidance). * In GHC.Core.Opt.Simplify.Utils.interestingArg, - return ValueArg for OtherCon [c1,c2, ...], but - return NonTrivArg for OtherCon [] This makes a function a little less likely to inline if all we know is that the argument is evaluated, but nothing else. * isConLikeUnfolding is no longer true for OtherCon {}. This propagates to exprIsConLike. Con-like-ness has /positive/ information. Join points ~~~~~~~~~~~ * Be very careful about inlining join points. See these two long Notes Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline * When making join points, don't do so if the join point is so small it will immediately be inlined; check uncondInlineJoin. * In GHC.Core.Opt.Simplify.Inline.tryUnfolding, improve the inlining heuristics for join points. In general we /do not/ want to inline join points /even if they are small/. See Note [Duplicating join points] GHC.Core.Opt.Simplify.Iteration. But sometimes we do: see Note [Inlining join points] in GHC.Core.Opt.Simplify.Inline; and the new `isBetterUnfoldingThan` function. * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * In GHC.Core.Unfold.sizeExpr, make jumps small, so that we don't penalise having a non-inlined join point. Performance changes ~~~~~~~~~~~~~~~~~~~ * Binary sizes fall by around 2.6%, according to nofib. * Compile times improve slightly. Here are the figures over 1%. I investiate the biggest differnce in T18304. It's a very small module, just a few hundred nodes. The large percentage difffence is due to a single function that didn't quite inline before, and does now, making code size a bit bigger. I decided gains outweighed the losses. Metrics: compile_time/bytes allocated (changes over +/- 1%) ------------------------------------------------ CoOpt_Singletons(normal) -9.2% GOOD LargeRecord(normal) -23.5% GOOD MultiComponentModulesRecomp(normal) +1.2% MultiLayerModulesTH_OneShot(normal) +4.1% BAD PmSeriesS(normal) -3.8% PmSeriesV(normal) -1.5% T11195(normal) -1.3% T12227(normal) -20.4% GOOD T12545(normal) -3.2% T12707(normal) -2.1% GOOD T13253(normal) -1.2% T13253-spj(normal) +8.1% BAD T13386(normal) -3.1% GOOD T14766(normal) -2.6% GOOD T15164(normal) -1.4% T15304(normal) +1.2% T15630(normal) -8.2% T15630a(normal) NEW T15703(normal) -14.7% GOOD T16577(normal) -2.3% GOOD T17516(normal) -39.7% GOOD T18140(normal) +1.2% T18223(normal) -17.1% GOOD T18282(normal) -5.0% GOOD T18304(normal) +10.8% BAD T18923(normal) -2.9% GOOD T1969(normal) +1.0% T19695(normal) -1.5% T20049(normal) -12.7% GOOD T21839c(normal) -4.1% GOOD T3064(normal) -1.5% T3294(normal) +1.2% BAD T4801(normal) +1.2% T5030(normal) -15.2% GOOD T5321Fun(normal) -2.2% GOOD T6048(optasm) -16.8% GOOD T783(normal) -1.2% T8095(normal) -6.0% GOOD T9630(normal) -4.7% GOOD T9961(normal) +1.9% BAD WWRec(normal) -1.4% info_table_map_perf(normal) -1.3% parsing001(normal) +1.5% geo. mean -2.0% minimum -39.7% maximum +10.8% * Runtimes generally improve. In the testsuite perf/should_run gives: Metrics: runtime/bytes allocated ------------------------------------------ Conversions(normal) -0.3% T13536a(optasm) -41.7% GOOD T4830(normal) -0.1% haddock.Cabal(normal) -0.1% haddock.base(normal) -0.1% haddock.compiler(normal) -0.1% geo. mean -0.8% minimum -41.7% maximum +0.0% * For runtime, nofib is a better test. The news is mostly good. Here are the number more than +/- 0.1%: # bytes allocated ==========================++========== imaginary/digits-of-e1 || -14.40% imaginary/digits-of-e2 || -4.41% imaginary/paraffins || -0.17% imaginary/rfib || -0.15% imaginary/wheel-sieve2 || -0.10% real/compress || -0.47% real/fluid || -0.10% real/fulsom || +0.14% real/gamteb || -1.47% real/gg || -0.20% real/infer || +0.24% real/pic || -0.23% real/prolog || -0.36% real/scs || -0.46% real/smallpt || +4.03% shootout/k-nucleotide || -20.23% shootout/n-body || -0.42% shootout/spectral-norm || -0.13% spectral/boyer2 || -3.80% spectral/constraints || -0.27% spectral/hartel/ida || -0.82% spectral/mate || -20.34% spectral/para || +0.46% spectral/rewrite || +1.30% spectral/sphere || -0.14% ==========================++========== geom mean || -0.59% real/smallpt has a huge nest of local definitions, and I could not pin down a reason for a regression. But there are three big wins! Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12707 T13386 T13536a T14766 T15703 T16577 T17516 T18223 T18282 T18923 T21839c T20049 T5321Fun T5030 T6048 T8095 T9630 T783 Metric Increase: MultiLayerModulesTH_OneShot T13253-spj T18304 T18698a T9961 T3294 - - - - - 27db3c5e by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Testsuite message changes from simplifier improvements - - - - - 271a7812 by Simon Peyton Jones at 2024-04-03T01:27:55-04:00 Account for bottoming functions in OccurAnal This fixes #24582, a small but long-standing bug - - - - - 0fde229f by Ben Gamari at 2024-04-04T07:04:58-04:00 testsuite: Introduce template-haskell-exports test - - - - - 0c4a9686 by Luite Stegeman at 2024-04-04T07:05:39-04:00 Update correct counter in bumpTickyAllocd - - - - - 5f085d3a by Fendor at 2024-04-04T14:47:33-04:00 Replace `SizedSeq` with `FlatBag` for flattened structure LinkedLists are notoriously memory ineffiecient when all we do is traversing a structure. As 'UnlinkedBCO' has been identified as a data structure that impacts the overall memory usage of GHCi sessions, we avoid linked lists and prefer flattened structure for storing. We introduce a new memory efficient representation of sequential elements that has special support for the cases: * Empty * Singleton * Tuple Elements This improves sharing in the 'Empty' case and avoids the overhead of 'Array' until its constant overhead is justified. - - - - - 82cfe10c by Fendor at 2024-04-04T14:47:33-04:00 Compact FlatBag array representation `Array` contains three additional `Word`'s we do not need in `FlatBag`. Move `FlatBag` to `SmallArray`. Expand the API of SmallArray by `sizeofSmallArray` and add common traversal functions, such as `mapSmallArray` and `foldMapSmallArray`. Additionally, allow users to force the elements of a `SmallArray` via `rnfSmallArray`. - - - - - 36a75b80 by Andrei Borzenkov at 2024-04-04T14:48:10-04:00 Change how invisible patterns represented in haskell syntax and TH AST (#24557) Before this patch: data ArgPat p = InvisPat (LHsType p) | VisPat (LPat p) With this patch: data Pat p = ... | InvisPat (LHsType p) ... And the same transformation in the TH land. The rest of the changes is just updating code to handle new AST and writing tests to check if it is possible to create invalid states using TH. Metric Increase: MultiLayerModulesTH_OneShot - - - - - 28009fbc by Matthew Pickering at 2024-04-04T14:48:46-04:00 Fix off by one error in seekBinNoExpand and seekBin - - - - - 9b9e031b by Ben Gamari at 2024-04-04T21:30:08-04:00 compiler: Allow more types in GHCForeignImportPrim For many, many years `GHCForeignImportPrim` has suffered from the rather restrictive limitation of not allowing any non-trivial types in arguments or results. This limitation was justified by the code generator allegely barfing in the presence of such types. However, this restriction appears to originate well before the NCG rewrite and the new NCG does not appear to have any trouble with such types (see the added `T24598` test). Lift this restriction. Fixes #24598. - - - - - 1324b862 by Alan Zimmerman at 2024-04-04T21:30:44-04:00 EPA: Use EpaLocation not SrcSpan in ForeignDecls This allows us to update them for makeDeltaAst in ghc-exactprint - - - - - 9d7cb414 by Sebastian Graf at 2024-04-05T16:04:01+02:00 CorePrep: Attach evaldUnfolding to floats to detect more values See `Note [Pin evaluatedness on floats]`. - - - - - 68499bef by Sebastian Graf at 2024-04-05T18:24:00+02:00 Make DataCon workers strict in strict fields (#20749) This patch tweaks `exprIsConApp_maybe`, `exprIsHNF` and friends, and Demand Analysis so that they exploit and maintain strictness of DataCon workers. See `Note [Strict fields in Core]` for details. Very little needed to change, and it puts field seq insertion done by Tag Inference into a new perspective: That of *implementing* strict field semantics. Before Tag Inference, DataCon workers are strict. Afterwards they are effectively lazy and field seqs happen around use sites. History has shown that there is no other way to guarantee taggedness and thus the STG Strict Field Invariant. Knock-on changes: * `exprIsHNF` previously used `exprOkForSpeculation` on unlifted arguments instead of recursing into `exprIsHNF`. That regressed the termination analysis in CPR analysis (which simply calls out to `exprIsHNF`), so I made it call `exprOkForSpeculation`, too. * There's a small regression in Demand Analysis, visible in the changed test output of T16859: Previously, a field seq on a variable would give that variable a "used exactly once" demand, now it's "used at least once", because `dmdTransformDataConSig` accounts for future uses of the field that actually all go through the case binder (and hence won't re-enter the potential thunk). The difference should hardly be observable. * The Simplifier's fast path for data constructors only applies to lazy data constructors now. I observed regressions involving Data.Binary.Put's `Pair` data type. * Unfortunately, T21392 does no longer reproduce after this patch, so I marked it as "not broken" in order to track whether we regress again in the future. Fixes #20749, the satisfying conclusion of an annoying saga (cf. the ideas in #21497 and #22475). Co-Authored-By: Jaro Reinders <jaro.reinders at gmail.com> - - - - - 18 changed files: - .ghcid - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/default.nix - .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/recompress-all - .gitlab/rel_eng/upload.sh - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - CODEOWNERS - compiler/GHC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12b80370a82b4191558aef01eb7203035193c0a2...68499bef56baf617dd17168c25437d8f692ba5d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12b80370a82b4191558aef01eb7203035193c0a2...68499bef56baf617dd17168c25437d8f692ba5d7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 18:08:27 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 Apr 2024 14:08:27 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: compiler: Allow more types in GHCForeignImportPrim Message-ID: <66103e1b11704_2ba06f17d1d8c921ac@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9b9e031b by Ben Gamari at 2024-04-04T21:30:08-04:00 compiler: Allow more types in GHCForeignImportPrim For many, many years `GHCForeignImportPrim` has suffered from the rather restrictive limitation of not allowing any non-trivial types in arguments or results. This limitation was justified by the code generator allegely barfing in the presence of such types. However, this restriction appears to originate well before the NCG rewrite and the new NCG does not appear to have any trouble with such types (see the added `T24598` test). Lift this restriction. Fixes #24598. - - - - - 1324b862 by Alan Zimmerman at 2024-04-04T21:30:44-04:00 EPA: Use EpaLocation not SrcSpan in ForeignDecls This allows us to update them for makeDeltaAst in ghc-exactprint - - - - - f7f3164e by Alan Zimmerman at 2024-04-05T14:08:10-04:00 EPA: Use EpaLocation for RecFieldsDotDot So we can update it to a delta position in makeDeltaAst if needed. - - - - - 81bbfde9 by Matthew Pickering at 2024-04-05T14:08:11-04:00 Remove accidentally committed test.hs - - - - - 23 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/ThToHs.hs - − test.hs - testsuite/tests/ffi/should_fail/ccfail001.stderr - + testsuite/tests/ffi/should_run/T24598.hs - + testsuite/tests/ffi/should_run/T24598.stdout - + testsuite/tests/ffi/should_run/T24598_cmm.cmm - + testsuite/tests/ffi/should_run/T24598b.hs - + testsuite/tests/ffi/should_run/T24598b.stdout - + testsuite/tests/ffi/should_run/T24598b_cmm.cmm - + testsuite/tests/ffi/should_run/T24598c.hs - + testsuite/tests/ffi/should_run/T24598c.stdout - + testsuite/tests/ffi/should_run/T24598c_cmm.cmm - testsuite/tests/ffi/should_run/all.T - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1131,10 +1131,10 @@ type instance XForeignExport GhcTc = Coercion type instance XXForeignDecl (GhcPass _) = DataConCantHappen -type instance XCImport (GhcPass _) = Located SourceText -- original source text for the C entity +type instance XCImport (GhcPass _) = LocatedE SourceText -- original source text for the C entity type instance XXForeignImport (GhcPass _) = DataConCantHappen -type instance XCExport (GhcPass _) = Located SourceText -- original source text for the C entity +type instance XCExport (GhcPass _) = LocatedE SourceText -- original source text for the C entity type instance XXForeignExport (GhcPass _) = DataConCantHappen -- pretty printing of foreign declarations @@ -1399,6 +1399,6 @@ type instance Anno (WarnDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (AnnDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (RoleAnnotDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (Maybe Role) = EpAnnCO -type instance Anno CCallConv = SrcSpan -type instance Anno Safety = SrcSpan -type instance Anno CExportSpec = SrcSpan +type instance Anno CCallConv = EpaLocation +type instance Anno Safety = EpaLocation +type instance Anno CExportSpec = EpaLocation ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -350,7 +350,7 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hfbLHS instance Outputable (HsTyPat p) => Outputable (HsConPatTyArg p) where ppr (HsConPatTyArg _ ty) = char '@' <> ppr ty -instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ Located RecFieldsDotDot) +instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ LocatedE RecFieldsDotDot) => Outputable (HsRecFields p arg) where ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing }) = braces (fsep (punctuate comma (map ppr flds))) @@ -976,4 +976,4 @@ type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA type instance Anno (HsOverLit (GhcPass p)) = EpAnnCO type instance Anno ConLike = SrcSpanAnnN type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA -type instance Anno RecFieldsDotDot = SrcSpan +type instance Anno RecFieldsDotDot = EpaLocation ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -1830,7 +1830,7 @@ lPatImplicits = hs_lpat details (RecCon (HsRecFields { rec_dotdot = Nothing, rec_flds })) = hs_lpats $ map (hfbRHS . unLoc) rec_flds details (RecCon (HsRecFields { rec_dotdot = Just (L err_loc rec_dotdot), rec_flds })) - = [(err_loc, implicit_field_binders)] + = [(l2l err_loc, implicit_field_binders)] ++ hs_lpats explicit_pats where (explicit_pats, implicit_field_binders) ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -2095,15 +2095,15 @@ instance ToHie (LocatedA (ForeignDecl GhcRn)) where instance ToHie (ForeignImport GhcRn) where toHie (CImport (L c _) (L a _) (L b _) _ _) = concatM $ - [ locOnly a - , locOnly b - , locOnly c + [ locOnlyE a + , locOnlyE b + , locOnlyE c ] instance ToHie (ForeignExport GhcRn) where toHie (CExport (L b _) (L a _)) = concatM $ - [ locOnly a - , locOnly b + [ locOnlyE a + , locOnlyE b ] instance ToHie (LocatedA (WarnDecls GhcRn)) where ===================================== compiler/GHC/Iface/Ext/Utils.hs ===================================== @@ -533,6 +533,10 @@ locOnly (RealSrcSpan span _) = do pure [Node e span []] locOnly _ = pure [] +locOnlyE :: Monad m => EpaLocation -> ReaderT NodeOrigin m [HieAST a] +locOnlyE (EpaSpan s) = locOnly s +locOnlyE _ = pure [] + mkScope :: (HasLoc a) => a -> Scope mkScope a = case getHasLoc a of (RealSrcSpan sp _) -> LocalScope sp ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -39,6 +39,7 @@ module GHC.Parser.Annotation ( -- ** Annotations in 'GenLocated' LocatedA, LocatedL, LocatedC, LocatedN, LocatedAn, LocatedP, SrcSpanAnnA, SrcSpanAnnL, SrcSpanAnnP, SrcSpanAnnC, SrcSpanAnnN, + LocatedE, -- ** Annotation data types used in 'GenLocated' @@ -644,6 +645,8 @@ type SrcSpanAnnL = EpAnn AnnList type SrcSpanAnnP = EpAnn AnnPragma type SrcSpanAnnC = EpAnn AnnContext +type LocatedE = GenLocated EpaLocation + -- | General representation of a 'GenLocated' type carrying a -- parameterised annotation type. type LocatedAn an = GenLocated (EpAnn an) @@ -1049,9 +1052,12 @@ reLoc (L la a) = L (noAnnSrcSpan $ locA (L la a) ) a class HasAnnotation e where noAnnSrcSpan :: SrcSpan -> e -instance HasAnnotation (SrcSpan) where +instance HasAnnotation SrcSpan where noAnnSrcSpan l = l +instance HasAnnotation EpaLocation where + noAnnSrcSpan l = EpaSpan l + instance (NoAnn ann) => HasAnnotation (EpAnn ann) where noAnnSrcSpan l = EpAnn (spanAsAnchor l) noAnn emptyComments @@ -1452,6 +1458,10 @@ instance (Outputable a, OutputableBndr e) pprInfixOcc = pprInfixOcc . unLoc pprPrefixOcc = pprPrefixOcc . unLoc +instance (Outputable e) + => Outputable (GenLocated EpaLocation e) where + ppr = pprLocated + instance Outputable ParenType where ppr t = text (show t) ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -2679,7 +2679,7 @@ mkRdrRecordCon con flds anns mk_rec_fields :: [LocatedA (HsRecField (GhcPass p) arg)] -> Maybe SrcSpan -> HsRecFields (GhcPass p) arg mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing } mk_rec_fields fs (Just s) = HsRecFields { rec_flds = fs - , rec_dotdot = Just (L s (RecFieldsDotDot $ length fs)) } + , rec_dotdot = Just (L (l2l s) (RecFieldsDotDot $ length fs)) } mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs mk_rec_upd_field (HsFieldBind noAnn (L loc (FieldOcc _ rdr)) arg pun) @@ -2766,7 +2766,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) = -- name (cf section 8.5.1 in Haskell 2010 report). mkCImport = do let e = unpackFS entity - case parseCImport cconv safety (mkExtName (unLoc v)) e (L loc esrc) of + case parseCImport (reLoc cconv) (reLoc safety) (mkExtName (unLoc v)) e (L loc esrc) of Nothing -> addFatalError $ mkPlainErrorMsgEnvelope loc $ PsErrMalformedEntityString Just importSpec -> return importSpec @@ -2782,7 +2782,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) = then mkExtName (unLoc v) else entity funcTarget = CFunction (StaticTarget esrc entity' Nothing True) - importSpec = CImport (L loc esrc) cconv safety Nothing funcTarget + importSpec = CImport (L (l2l loc) esrc) (reLoc cconv) (reLoc safety) Nothing funcTarget returnSpec spec = return $ \ann -> ForD noExtField $ ForeignImport { fd_i_ext = ann @@ -2796,7 +2796,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) = -- the string "foo" is ambiguous: either a header or a C identifier. The -- C identifier case comes first in the alternatives below, so we pick -- that one. -parseCImport :: Located CCallConv -> Located Safety -> FastString -> String +parseCImport :: LocatedE CCallConv -> LocatedE Safety -> FastString -> String -> Located SourceText -> Maybe (ForeignImport (GhcPass p)) parseCImport cconv safety nm str sourceText = @@ -2826,7 +2826,7 @@ parseCImport cconv safety nm str sourceText = | id_char c -> pfail _ -> return () - mk h n = CImport sourceText cconv safety h n + mk h n = CImport (reLoc sourceText) (reLoc cconv) (reLoc safety) h n hdr_char c = not (isSpace c) -- header files are filenames, which can contain @@ -2861,7 +2861,7 @@ mkExport :: Located CCallConv mkExport (L lc cconv) (L le (StringLiteral esrc entity _), v, ty) = return $ \ann -> ForD noExtField $ ForeignExport { fd_e_ext = ann, fd_name = v, fd_sig_ty = ty - , fd_fe = CExport (L le esrc) (L lc (CExportStatic esrc entity' cconv)) } + , fd_fe = CExport (L (l2l le) esrc) (L (l2l lc) (CExportStatic esrc entity' cconv)) } where entity' | nullFS entity = mkExtName (unLoc v) | otherwise = entity ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -775,7 +775,7 @@ rnHsRecPatsAndThen mk (L _ con) do { arg' <- rnLPatAndThen (nested_mk dd mk (RecFieldsDotDot n')) (hfbRHS fld) ; return (L l (fld { hfbRHS = arg' })) } - loc = maybe noSrcSpan getLoc dd + loc = maybe noSrcSpan getLocA dd -- Don't warn for let P{..} = ... in ... check_unused_wildcard = case mk of @@ -873,12 +873,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) , hfbRHS = arg' , hfbPun = pun } } - rn_dotdot :: Maybe (Located RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat + rn_dotdot :: Maybe (LocatedE RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat -> Maybe Name -- The constructor (Nothing for an -- out of scope constructor) -> [LHsRecField GhcRn (LocatedA arg)] -- Explicit fields -> RnM ([LHsRecField GhcRn (LocatedA arg)]) -- Field Labels we need to fill in - rn_dotdot (Just (L loc (RecFieldsDotDot n))) (Just con) flds -- ".." on record construction / pat match + rn_dotdot (Just (L loc_e (RecFieldsDotDot n))) (Just con) flds -- ".." on record construction / pat match | not (isUnboundName con) -- This test is because if the constructor -- isn't in scope the constructor lookup will add -- an error but still return an unbound name. We @@ -910,6 +910,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) _other -> True ] ; addUsedGREs NoDeprecationWarnings dot_dot_gres + ; let loc = locA loc_e ; let locn = noAnnSrcSpan loc ; return [ L (noAnnSrcSpan loc) (HsFieldBind { hfbAnn = noAnn ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -84,7 +84,6 @@ import Control.Monad.Trans.Writer.CPS import Control.Monad.Trans.Class ( lift ) import Data.Maybe (isJust) -import GHC.Types.RepType (tyConPrimRep) import GHC.Builtin.Types (unitTyCon) -- Defines a binding @@ -737,7 +736,6 @@ marshalablePrimTyCon tc = isPrimTyCon tc && not (isLiftedTypeKind (tyConResKind marshalableTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason marshalableTyCon dflags tc | marshalablePrimTyCon tc - , not (null (tyConPrimRep tc)) -- Note [Marshalling void] = validIfUnliftedFFITypes dflags | otherwise = boxedMarshalableTyCon tc @@ -772,7 +770,6 @@ legalFIPrimResultTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledRe -- types and also unboxed tuple and sum result types. legalFIPrimResultTyCon dflags tc | marshalablePrimTyCon tc - , not (null (tyConPrimRep tc)) -- Note [Marshalling void] = validIfUnliftedFFITypes dflags | isUnboxedTupleTyCon tc || isUnboxedSumTyCon tc @@ -786,13 +783,3 @@ validIfUnliftedFFITypes dflags | xopt LangExt.UnliftedFFITypes dflags = IsValid | otherwise = NotValid UnliftedFFITypesNeeded -{- -Note [Marshalling void] -~~~~~~~~~~~~~~~~~~~~~~~ -We don't treat State# (whose PrimRep is VoidRep) as marshalable. -In turn that means you can't write - foreign import foo :: Int -> State# RealWorld - -Reason: the back end falls over with panic "primRepHint:VoidRep"; - and there is no compelling reason to permit it --} ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -799,7 +799,8 @@ cvt_fundep (TH.FunDep xs ys) = do { xs' <- mapM tNameN xs cvtForD :: Foreign -> CvtM (ForeignDecl GhcPs) cvtForD (ImportF callconv safety from nm ty) = - do { l <- getL + do { ls <- getL + ; let l = l2l ls ; if -- the prim and javascript calling conventions do not support headers -- and are inserted verbatim, analogous to mkImport in GHC.Parser.PostProcess | callconv == TH.Prim || callconv == TH.JavaScript @@ -809,7 +810,7 @@ cvtForD (ImportF callconv safety from nm ty) = True))) | Just impspec <- parseCImport (L l (cvt_conv callconv)) (L l safety') (mkFastString (TH.nameBase nm)) - from (L l $ quotedSourceText from) + from (L ls $ quotedSourceText from) -> mk_imp impspec | otherwise -> failWith $ InvalidCCallImpent from } @@ -831,7 +832,8 @@ cvtForD (ImportF callconv safety from nm ty) = cvtForD (ExportF callconv as nm ty) = do { nm' <- vNameN nm ; ty' <- cvtSigType ty - ; l <- getL + ; ls <- getL + ; let l = l2l ls ; let astxt = mkFastString as ; let e = CExport (L l (SourceText astxt)) (L l (CExportStatic (SourceText astxt) astxt ===================================== test.hs deleted ===================================== @@ -1,14 +0,0 @@ -import Data.Char -import Data.Foldable --- | Just like 'GHC.ResponseFile.escapeArg', but it is not exposed from base. -escapeArg :: String -> String -escapeArg = reverse . foldl' escape [] - -escape :: String -> Char -> String -escape cs c - | isSpace c - || '\\' == c - || '\'' == c - || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result - | otherwise = c:cs - ===================================== testsuite/tests/ffi/should_fail/ccfail001.stderr ===================================== @@ -1,6 +1,8 @@ -ccfail001.hs:10:1: error: [GHC-89401] +ccfail001.hs:10:1: error: [GHC-10964] • Unacceptable result type in foreign declaration: ‘State# RealWorld’ cannot be marshalled in a foreign call + UnliftedFFITypes is required to marshal unlifted types • When checking declaration: foreign import ccall safe foo :: Int -> State# RealWorld + Suggested fix: Perhaps you intended to use UnliftedFFITypes ===================================== testsuite/tests/ffi/should_run/T24598.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE MagicHash #-} + +-- | Test that `foreign import prim` imports handle `State#` in results correctly. +module Main where + +import GHC.IO +import GHC.Int +import GHC.Exts + +foreign import prim "hello" + hello# :: State# RealWorld -> (# State# RealWorld, Int# #) + +main :: IO () +main = hello >>= print + +hello :: IO Int +hello = IO $ \s -> case hello# s of (# s', n# #) -> (# s', I# n# #) ===================================== testsuite/tests/ffi/should_run/T24598.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/ffi/should_run/T24598_cmm.cmm ===================================== @@ -0,0 +1,5 @@ +#include "Cmm.h" + +hello() { + return (42); +} ===================================== testsuite/tests/ffi/should_run/T24598b.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE MagicHash #-} + +-- | Test that `foreign import prim` imports handle `State#` in arguments correctly. +module Main where + +import GHC.IO +import GHC.Int +import GHC.Exts + +foreign import prim "hello" + hello# :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #) + +main :: IO () +main = hello 21 >>= print + +hello :: Int -> IO Int +hello (I# n#) = IO $ \s -> + case hello# n# s of (# s', n# #) -> (# s', I# n# #) + ===================================== testsuite/tests/ffi/should_run/T24598b.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/ffi/should_run/T24598b_cmm.cmm ===================================== @@ -0,0 +1,5 @@ +#include "Cmm.h" + +hello(W_ n) { + return (2*n); +} ===================================== testsuite/tests/ffi/should_run/T24598c.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE MagicHash #-} + +-- | Test that `foreign import prim` imports handle `State#` in arguments correctly. +module Main where + +import GHC.IO +import GHC.Exts + +foreign import prim "hello" + hello# :: State# RealWorld -> State# RealWorld + +main :: IO () +main = hello + +hello :: IO () +hello = IO $ \s -> + case hello# s of s' -> (# s', () #) + ===================================== testsuite/tests/ffi/should_run/T24598c.stdout ===================================== @@ -0,0 +1 @@ +hello ===================================== testsuite/tests/ffi/should_run/T24598c_cmm.cmm ===================================== @@ -0,0 +1,15 @@ +#include "Cmm.h" + +#if !defined(UnregisterisedCompiler) +import CLOSURE test_str; +#endif + +section "data" { + test_str: bits8[] "hello"; +} + +hello() { + CInt r; + (r) = ccall puts(test_str "ptr"); + return (); +} ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -268,3 +268,7 @@ test('T24314', # libffi-wasm doesn't support more than 4 args yet when(arch('wasm32'), skip)], compile_and_run, ['T24314_c.c']) + +test('T24598', req_cmm, compile_and_run, ['T24598_cmm.cmm']) +test('T24598b', req_cmm, compile_and_run, ['T24598b_cmm.cmm']) +test('T24598c', req_cmm, compile_and_run, ['T24598c_cmm.cmm']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -738,9 +738,9 @@ printStringAtAAC capture (EpaDelta d cs) s = do -- --------------------------------------------------------------------- -markExternalSourceText :: (Monad m, Monoid w) => SrcSpan -> SourceText -> String -> EP w m () -markExternalSourceText l NoSourceText txt = printStringAtRs (realSrcSpan l) txt >> return () -markExternalSourceText l (SourceText txt) _ = printStringAtRs (realSrcSpan l) (unpackFS txt) >> return () +markExternalSourceTextE :: (Monad m, Monoid w) => EpaLocation -> SourceText -> String -> EP w m EpaLocation +markExternalSourceTextE l NoSourceText txt = printStringAtAA l txt +markExternalSourceTextE l (SourceText txt) _ = printStringAtAA l (unpackFS txt) -- --------------------------------------------------------------------- @@ -1587,6 +1587,15 @@ instance (ExactPrint a) => ExactPrint (Located a) where exact (L l a) = L l <$> markAnnotated a +instance (ExactPrint a) => ExactPrint (LocatedE a) where + getAnnotationEntry (L l _) = Entry l [] emptyComments NoFlushComments CanUpdateAnchorOnly + setAnnotationAnchor (L _ a) anc _ts _cs = L anc a + + exact (L la a) = do + debugM $ "LocatedE a:la loc=" ++ show (ss2range $ locA la) + a' <- markAnnotated a + return (L la a') + instance (ExactPrint a) => ExactPrint (LocatedA a) where getAnnotationEntry = entryFromLocatedA setAnnotationAnchor la anc ts cs = setAnchorAn la anc ts cs @@ -2009,11 +2018,15 @@ instance ExactPrint (ForeignDecl GhcPs) where instance ExactPrint (ForeignImport GhcPs) where getAnnotationEntry = const NoEntryVal setAnnotationAnchor a _ _ _ = a - exact (CImport (L ls src) cconv safety@(L ll _) mh imp) = do + exact (CImport (L ls src) cconv safety@(L l _) mh imp) = do cconv' <- markAnnotated cconv - unless (ll == noSrcSpan) $ markAnnotated safety >> return () - unless (ls == noSrcSpan) $ markExternalSourceText ls src "" >> return () - return (CImport (L ls src) cconv' safety mh imp) + safety' <- if notDodgyE l + then markAnnotated safety + else return safety + ls' <- if notDodgyE ls + then markExternalSourceTextE ls src "" + else return ls + return (CImport (L ls' src) cconv' safety' mh imp) -- --------------------------------------------------------------------- @@ -2023,8 +2036,10 @@ instance ExactPrint (ForeignExport GhcPs) where exact (CExport (L ls src) spec) = do debugM $ "CExport starting" spec' <- markAnnotated spec - unless (ls == noSrcSpan) $ markExternalSourceText ls src "" - return (CExport (L ls src) spec') + ls' <- if notDodgyE ls + then markExternalSourceTextE ls src "" + else return ls + return (CExport (L ls' src) spec') -- --------------------------------------------------------------------- @@ -3240,6 +3255,12 @@ markMaybeDodgyStmts an stmts = return (an, r) else return (an, stmts) +notDodgyE :: EpaLocation -> Bool +notDodgyE anc = + case anc of + EpaSpan s -> isGoodSrcSpan s + EpaDelta{} -> True + -- --------------------------------------------------------------------- instance ExactPrint (HsPragE GhcPs) where getAnnotationEntry HsPragSCC{} = NoEntryVal @@ -3307,12 +3328,13 @@ instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where setAnnotationAnchor a _ _ _ = a exact (HsRecFields fields mdot) = do fields' <- markAnnotated fields - case mdot of - Nothing -> return () - Just (L ss _) -> - printStringAtSs ss ".." >> return () + mdot' <- case mdot of + Nothing -> return Nothing + Just (L ss d) -> do + ss' <- printStringAtAA ss ".." + return $ Just (L ss' d) -- Note: mdot contains the SrcSpan where the ".." appears, if present - return (HsRecFields fields' mdot) + return (HsRecFields fields' mdot') -- --------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c52eb51a530ef4e6e6cf108056e87a74aecdeae1...81bbfde980e4a60daafd22de09609e91c261ae4a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c52eb51a530ef4e6e6cf108056e87a74aecdeae1...81bbfde980e4a60daafd22de09609e91c261ae4a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 20:58:45 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 Apr 2024 16:58:45 -0400 Subject: [Git][ghc/ghc][master] EPA: Use EpaLocation for RecFieldsDotDot Message-ID: <66106605e0bf9_a58d32be83c10456@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 19883a23 by Alan Zimmerman at 2024-04-05T16:58:17-04:00 EPA: Use EpaLocation for RecFieldsDotDot So we can update it to a delta position in makeDeltaAst if needed. - - - - - 5 changed files: - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Pat.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -350,7 +350,7 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hfbLHS instance Outputable (HsTyPat p) => Outputable (HsConPatTyArg p) where ppr (HsConPatTyArg _ ty) = char '@' <> ppr ty -instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ Located RecFieldsDotDot) +instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ LocatedE RecFieldsDotDot) => Outputable (HsRecFields p arg) where ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing }) = braces (fsep (punctuate comma (map ppr flds))) @@ -976,4 +976,4 @@ type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA type instance Anno (HsOverLit (GhcPass p)) = EpAnnCO type instance Anno ConLike = SrcSpanAnnN type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA -type instance Anno RecFieldsDotDot = SrcSpan +type instance Anno RecFieldsDotDot = EpaLocation ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -1830,7 +1830,7 @@ lPatImplicits = hs_lpat details (RecCon (HsRecFields { rec_dotdot = Nothing, rec_flds })) = hs_lpats $ map (hfbRHS . unLoc) rec_flds details (RecCon (HsRecFields { rec_dotdot = Just (L err_loc rec_dotdot), rec_flds })) - = [(err_loc, implicit_field_binders)] + = [(l2l err_loc, implicit_field_binders)] ++ hs_lpats explicit_pats where (explicit_pats, implicit_field_binders) ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -2679,7 +2679,7 @@ mkRdrRecordCon con flds anns mk_rec_fields :: [LocatedA (HsRecField (GhcPass p) arg)] -> Maybe SrcSpan -> HsRecFields (GhcPass p) arg mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing } mk_rec_fields fs (Just s) = HsRecFields { rec_flds = fs - , rec_dotdot = Just (L s (RecFieldsDotDot $ length fs)) } + , rec_dotdot = Just (L (l2l s) (RecFieldsDotDot $ length fs)) } mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs mk_rec_upd_field (HsFieldBind noAnn (L loc (FieldOcc _ rdr)) arg pun) ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -775,7 +775,7 @@ rnHsRecPatsAndThen mk (L _ con) do { arg' <- rnLPatAndThen (nested_mk dd mk (RecFieldsDotDot n')) (hfbRHS fld) ; return (L l (fld { hfbRHS = arg' })) } - loc = maybe noSrcSpan getLoc dd + loc = maybe noSrcSpan getLocA dd -- Don't warn for let P{..} = ... in ... check_unused_wildcard = case mk of @@ -873,12 +873,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) , hfbRHS = arg' , hfbPun = pun } } - rn_dotdot :: Maybe (Located RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat + rn_dotdot :: Maybe (LocatedE RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat -> Maybe Name -- The constructor (Nothing for an -- out of scope constructor) -> [LHsRecField GhcRn (LocatedA arg)] -- Explicit fields -> RnM ([LHsRecField GhcRn (LocatedA arg)]) -- Field Labels we need to fill in - rn_dotdot (Just (L loc (RecFieldsDotDot n))) (Just con) flds -- ".." on record construction / pat match + rn_dotdot (Just (L loc_e (RecFieldsDotDot n))) (Just con) flds -- ".." on record construction / pat match | not (isUnboundName con) -- This test is because if the constructor -- isn't in scope the constructor lookup will add -- an error but still return an unbound name. We @@ -910,6 +910,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) _other -> True ] ; addUsedGREs NoDeprecationWarnings dot_dot_gres + ; let loc = locA loc_e ; let locn = noAnnSrcSpan loc ; return [ L (noAnnSrcSpan loc) (HsFieldBind { hfbAnn = noAnn ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -3328,12 +3328,13 @@ instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where setAnnotationAnchor a _ _ _ = a exact (HsRecFields fields mdot) = do fields' <- markAnnotated fields - case mdot of - Nothing -> return () - Just (L ss _) -> - printStringAtSs ss ".." >> return () + mdot' <- case mdot of + Nothing -> return Nothing + Just (L ss d) -> do + ss' <- printStringAtAA ss ".." + return $ Just (L ss' d) -- Note: mdot contains the SrcSpan where the ".." appears, if present - return (HsRecFields fields' mdot) + return (HsRecFields fields' mdot') -- --------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19883a23b8bc704118fa663d8bab00a503b5a527 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19883a23b8bc704118fa663d8bab00a503b5a527 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 20:59:25 2024 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 Apr 2024 16:59:25 -0400 Subject: [Git][ghc/ghc][master] Remove accidentally committed test.hs Message-ID: <6610662d10708_a58d33d7fc01075cf@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e8724327 by Matthew Pickering at 2024-04-05T16:58:53-04:00 Remove accidentally committed test.hs - - - - - 1 changed file: - − test.hs Changes: ===================================== test.hs deleted ===================================== @@ -1,14 +0,0 @@ -import Data.Char -import Data.Foldable --- | Just like 'GHC.ResponseFile.escapeArg', but it is not exposed from base. -escapeArg :: String -> String -escapeArg = reverse . foldl' escape [] - -escape :: String -> Char -> String -escape cs c - | isSpace c - || '\\' == c - || '\'' == c - || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result - | otherwise = c:cs - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8724327d995a67d3eb066dfe4f9ee03e64dd6b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8724327d995a67d3eb066dfe4f9ee03e64dd6b5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Apr 5 21:25:47 2024 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 05 Apr 2024 17:25:47 -0400 Subject: [Git][ghc/ghc][wip/bump-terminfo] 4487 commits: Remove outdated note about pragma layout Message-ID: <66106c5b6cb87_a58d38a7e3810812e@gitlab.mail> Ben Gamari pushed to branch wip/bump-terminfo at Glasgow Haskell Compiler / GHC Commits: 62b4a89b by taylorfausak at 2021-09-28T09:57:37-04:00 Remove outdated note about pragma layout - - - - - 028abd5b by Benjamin Maurer at 2021-09-28T09:58:13-04:00 Documented yet undocumented dump flags #18641 - - - - - b8d98827 by Richard Eisenberg at 2021-09-29T09:40:14-04:00 Compare FunTys as if they were TyConApps. See Note [Equality on FunTys] in TyCoRep. Close #17675. Close #17655, about documentation improvements included in this patch. Close #19677, about a further mistake around FunTy. test cases: typecheck/should_compile/T19677 - - - - - be77a9e0 by Fabian Thorand at 2021-09-29T09:40:51-04:00 Remove special case for large objects in allocateForCompact allocateForCompact() is called when the current allocation for the compact region does not fit in the nursery. It previously had a special case for objects exceeding the large object threshold. In that case, it would allocate a new compact region block just for that object. That led to a lot of small blocks being allocated in compact regions with a larger default block size (`autoBlockW`). This commit removes this special case because having a lot of small compact region blocks contributes significantly to memory fragmentation. The removal should be valid because - a more generic case for allocating a new compact region block follows at the end of allocateForCompact(), and that one takes `autoBlockW` into account - the reason for allocating separate blocks for large objects in the main heap seems to be to avoid copying during GCs, but once inside the compact region, the object will never be copied anyway. Fixes #18757. A regression test T18757 was added. - - - - - cd603062 by Kirill Zaborsky at 2021-09-29T09:41:27-04:00 Fix comment typos - - - - - 162492ea by Alexander Kjeldaas at 2021-09-29T09:41:27-04:00 Document interaction between unsafe FFI and GC In the multi-threaded RTS this can lead to hard to debug performance issues. - - - - - 361da88a by Kamil Dworakowski at 2021-09-29T09:42:04-04:00 Add a regression test for #17912 - - - - - 5cc4bd57 by Benjamin Maurer at 2021-09-29T09:42:41-04:00 Rectifying COMMENT and `mkComment` across platforms to work with SDoc and exhibit similar behaviors. Issue 20400 - - - - - a2be9f34 by Ziyang Liu at 2021-09-29T09:43:19-04:00 Document that `eqType`/`coreView` do not look through type families This isn't clear from the existing doc. - - - - - c668fd2c by Andrea Condoluci at 2021-09-29T09:44:04-04:00 TH stage restriction check for constructors, selectors, and class methods Closes ticket #17820. - - - - - d46e34d0 by Andrea Condoluci at 2021-09-29T09:44:04-04:00 Add tests for T17820 - - - - - 770fcac8 by Ben Gamari at 2021-09-29T09:44:40-04:00 GHC: Drop dead packageDbModules It was already commented out and contained a reference to the non-deterministic nameEnvElts so let's just drop it. - - - - - 42492b76 by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Reimplement seqEltsUFM in terms of fold Rather than nonDetEltsUFM; this should eliminate some unnecessary list allocations. - - - - - 97ffd6d9 by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Rewrite all eltsUFM occurrences to nonDetEltsUFM And remove the former. - - - - - df8c5961 by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Fix name of GHC.Core.TyCon.Env.nameEnvElts Rename to nonDetTyConEnvElts. - - - - - 1f2ba67a by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Make nubAvails deterministic Surprisingly this previously didn't appear to introduce any visible non-determinism but it seems worth avoiding non-determinism here. - - - - - 7c90a180 by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Rename nameEnvElts -> nonDetNameEnvElts - - - - - 2e68d4fa by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Use seqEltsNameEnv rather that nameEnvElts - - - - - f66eaefd by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: occEnvElts -> nonDetOccEnvElts - - - - - 594ee2f4 by Matthew Pickering at 2021-09-30T00:56:30-04:00 testsuite: Make cabal01 more robust to large environments Sebastian unfortunately wrote a very long commit message in !5667 which caused `xargs` to fail on windows because the environment was too big. Fortunately `xargs` and `rm` don't need anything from the environment so just run those commands in an empty environment (which is what env -i achieves). - - - - - c261f220 by Sebastian Graf at 2021-09-30T00:56:30-04:00 Nested CPR light unleashed (#18174) This patch enables worker/wrapper for nested constructed products, as described in `Note [Nested CPR]`. The machinery for expressing Nested CPR was already there, since !5054. Worker/wrapper is equipped to exploit Nested CPR annotations since !5338. CPR analysis already handles applications in batches since !5753. This patch just needs to flip a few more switches: 1. In `cprTransformDataConWork`, we need to look at the field expressions and their `CprType`s to see whether the evaluation of the expressions terminates quickly (= is in HNF) or if they are put in strict fields. If that is the case, then we retain their CPR info and may unbox nestedly later on. More details in `Note [Nested CPR]`. 2. Enable nested `ConCPR` signatures in `GHC.Types.Cpr`. 3. In the `asConCpr` call in `GHC.Core.Opt.WorkWrap.Utils`, pass CPR info of fields to the `Unbox`. 4. Instead of giving CPR signatures to DataCon workers and wrappers, we now have `cprTransformDataConWork` for workers and treat wrappers by analysing their unfolding. As a result, the code from GHC.Types.Id.Make went away completely. 5. I deactivated worker/wrappering for recursive DataCons and wrote a function `isRecDataCon` to detect them. We really don't want to give `repeat` or `replicate` the Nested CPR property. See Note [CPR for recursive data structures] for which kind of recursive DataCons we target. 6. Fix a couple of tests and their outputs. I also documented that CPR can destroy sharing and lead to asymptotic increase in allocations (which is tracked by #13331/#19326) in `Note [CPR for data structures can destroy sharing]`. Nofib results: ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- ben-raytrace -3.1% -0.4% binary-trees +0.8% -2.9% digits-of-e2 +5.8% +1.2% event +0.8% -2.1% fannkuch-redux +0.0% -1.4% fish 0.0% -1.5% gamteb -1.4% -0.3% mkhprog +1.4% +0.8% multiplier +0.0% -1.9% pic -0.6% -0.1% reptile -20.9% -17.8% wave4main +4.8% +0.4% x2n1 -100.0% -7.6% -------------------------------------------------------------------------------- Min -95.0% -17.8% Max +5.8% +1.2% Geometric Mean -2.9% -0.4% ``` The huge wins in x2n1 (loopy list) and reptile (see #19970) are due to refraining from unboxing (:). Other benchmarks like digits-of-e2 or wave4main regress because of that. Ultimately there are no great improvements due to Nested CPR alone, but at least it's a win. Binary sizes decrease by 0.6%. There are a significant number of metric decreases. The most notable ones (>1%): ``` ManyAlternatives(normal) ghc/alloc 771656002.7 762187472.0 -1.2% ManyConstructors(normal) ghc/alloc 4191073418.7 4114369216.0 -1.8% MultiLayerModules(normal) ghc/alloc 3095678333.3 3128720704.0 +1.1% PmSeriesG(normal) ghc/alloc 50096429.3 51495664.0 +2.8% PmSeriesS(normal) ghc/alloc 63512989.3 64681600.0 +1.8% PmSeriesV(normal) ghc/alloc 62575424.0 63767208.0 +1.9% T10547(normal) ghc/alloc 29347469.3 29944240.0 +2.0% T11303b(normal) ghc/alloc 46018752.0 47367576.0 +2.9% T12150(optasm) ghc/alloc 81660890.7 82547696.0 +1.1% T12234(optasm) ghc/alloc 59451253.3 60357952.0 +1.5% T12545(normal) ghc/alloc 1705216250.7 1751278952.0 +2.7% T12707(normal) ghc/alloc 981000472.0 968489800.0 -1.3% GOOD T13056(optasm) ghc/alloc 389322664.0 372495160.0 -4.3% GOOD T13253(normal) ghc/alloc 337174229.3 341954576.0 +1.4% T13701(normal) ghc/alloc 2381455173.3 2439790328.0 +2.4% BAD T14052(ghci) ghc/alloc 2162530642.7 2139108784.0 -1.1% T14683(normal) ghc/alloc 3049744728.0 2977535064.0 -2.4% GOOD T14697(normal) ghc/alloc 362980213.3 369304512.0 +1.7% T15164(normal) ghc/alloc 1323102752.0 1307480600.0 -1.2% T15304(normal) ghc/alloc 1304607429.3 1291024568.0 -1.0% T16190(normal) ghc/alloc 281450410.7 284878048.0 +1.2% T16577(normal) ghc/alloc 7984960789.3 7811668768.0 -2.2% GOOD T17516(normal) ghc/alloc 1171051192.0 1153649664.0 -1.5% T17836(normal) ghc/alloc 1115569746.7 1098197592.0 -1.6% T17836b(normal) ghc/alloc 54322597.3 55518216.0 +2.2% T17977(normal) ghc/alloc 47071754.7 48403408.0 +2.8% T17977b(normal) ghc/alloc 42579133.3 43977392.0 +3.3% T18923(normal) ghc/alloc 71764237.3 72566240.0 +1.1% T1969(normal) ghc/alloc 784821002.7 773971776.0 -1.4% GOOD T3294(normal) ghc/alloc 1634913973.3 1614323584.0 -1.3% GOOD T4801(normal) ghc/alloc 295619648.0 292776440.0 -1.0% T5321FD(normal) ghc/alloc 278827858.7 276067280.0 -1.0% T5631(normal) ghc/alloc 586618202.7 577579960.0 -1.5% T5642(normal) ghc/alloc 494923048.0 487927208.0 -1.4% T5837(normal) ghc/alloc 37758061.3 39261608.0 +4.0% T9020(optasm) ghc/alloc 257362077.3 254672416.0 -1.0% T9198(normal) ghc/alloc 49313365.3 50603936.0 +2.6% BAD T9233(normal) ghc/alloc 704944258.7 685692712.0 -2.7% GOOD T9630(normal) ghc/alloc 1476621560.0 1455192784.0 -1.5% T9675(optasm) ghc/alloc 443183173.3 433859696.0 -2.1% GOOD T9872a(normal) ghc/alloc 1720926653.3 1693190072.0 -1.6% GOOD T9872b(normal) ghc/alloc 2185618061.3 2162277568.0 -1.1% GOOD T9872c(normal) ghc/alloc 1765842405.3 1733618088.0 -1.8% GOOD TcPlugin_RewritePerf(normal) ghc/alloc 2388882730.7 2365504696.0 -1.0% WWRec(normal) ghc/alloc 607073186.7 597512216.0 -1.6% T9203(normal) run/alloc 107284064.0 102881832.0 -4.1% haddock.Cabal(normal) run/alloc 24025329589.3 23768382560.0 -1.1% haddock.base(normal) run/alloc 25660521653.3 25370321824.0 -1.1% haddock.compiler(normal) run/alloc 74064171706.7 73358712280.0 -1.0% ``` The biggest exception to the rule is T13701 which seems to fluctuate as usual (not unlike T12545). T14697 has a similar quality, being a generated multi-module test. T5837 is small enough that it similarly doesn't measure anything significant besides module loading overhead. T13253 simply does one additional round of Simplification due to Nested CPR. There are also some apparent regressions in T9198, T12234 and PmSeriesG that we (@mpickering and I) were simply unable to reproduce locally. @mpickering tried to run the CI script in a local Docker container and actually found that T9198 and PmSeriesG *improved*. In MRs that were rebased on top this one, like !4229, I did not experience such increases. Let's not get hung up on these regression tests, they were meant to test for asymptotic regressions. The build-cabal test improves by 1.2% in -O0. Metric Increase: T10421 T12234 T12545 T13035 T13056 T13701 T14697 T18923 T5837 T9198 Metric Decrease: ManyConstructors T12545 T12707 T13056 T14683 T16577 T18223 T1969 T3294 T9203 T9233 T9675 T9872a T9872b T9872c T9961 TcPlugin_RewritePerf - - - - - 205f0f92 by Andrea Condoluci at 2021-09-30T00:57:09-04:00 Trees That Grow refactor for HsTick and HsBinTick Move HsTick and HsBinTick to XExpr, the extension tree of HsExpr. Part of #16830 . - - - - - e0923b98 by Ben Gamari at 2021-09-30T00:57:44-04:00 ghc-boot: Eliminate unnecessary use of getEnvironment Previously we were using `System.Environment.getEnvironment`, which decodes all environment variables into Haskell `String`s, where a simple environment lookup would do. This made the compiler's allocations unnecessarily dependent on the environment. Fixes #20431. - - - - - 941d3792 by Sylvain Henry at 2021-09-30T19:41:09-04:00 Rules for sized conversion primops (#19769) Metric Decrease: T12545 - - - - - adc41a77 by Matthew Pickering at 2021-09-30T19:41:44-04:00 driver: Fix -E -XCPP, copy output from CPP ouput rather than .hs output Fixes #20416 I thought about adding a test for this case but I struggled to think of something robust. Grepping -v3 will include different paths on different systems and the structure of the result file depends on which preprocessor you are using. - - - - - 94f3ce7e by Matthew Pickering at 2021-09-30T19:42:19-04:00 Recompilation: Handle -plugin-package correctly If a plugins was specified using the -plugin-package-(id) flag then the module it applied to was always recompiled. The recompilation checker was previously using `findImportedModule`, which looked for packages in the HPT and then in the package database but only for modules specified using `-package`. The correct lookup function for plugins is `findPluginModule`, therefore we check normal imports with `findImportedModule` and plugins with `findPluginModule`. Fixes #20417 - - - - - ef92a009 by Andreas Klebinger at 2021-09-30T19:42:54-04:00 NCG: Linear-reg-alloc: A few small implemenation tweaks. Removed an intermediate list via a fold. realRegsAlias: Manually inlined the list functions to get better code. Linear.hs added a bang somewhere. - - - - - 9606774d by Aaron Allen at 2021-10-01T09:04:10-04:00 Convert Diagnostics GHC.Tc.Gen.* (Part 3) Converts all diagnostics in the `GHC.Tc.Gen.Expr` module. (#20116) - - - - - 9600a5fb by Matthew Pickering at 2021-10-01T09:04:46-04:00 code gen: Improve efficiency of findPrefRealReg Old strategy: For each variable linearly scan through all the blocks and check to see if the variable is any of the block register mappings. This is very slow when you have a lot of blocks. New strategy: Maintain a map from virtual registers to the first real register the virtual register was assigned to. Consult this map in findPrefRealReg. The map is updated when the register mapping is updated and is hidden behind the BlockAssigment abstraction. On the mmark package this reduces compilation time from about 44s to 32s. Ticket: #19471 - - - - - e3701815 by Matthew Pickering at 2021-10-01T09:05:20-04:00 ci: Unset CI_* variables before run_hadrian and test_make The goal here is to somewhat sanitize the environment so that performance tests don't fluctuate as much as they have been doing. In particular the length of the commit message was causing benchmarks to increase because gitlab stored the whole commit message twice in environment variables. Therefore when we used `getEnvironment` it would cause more allocation because more string would be created. See #20431 ------------------------- Metric Decrease: T10421 T13035 T18140 T18923 T9198 T12234 T12425 ------------------------- - - - - - e401274a by Ben Gamari at 2021-10-02T05:18:03-04:00 gitlab-ci: Bump docker images To install libncurses-dev on Debian targets. - - - - - 42f49c4e by Ben Gamari at 2021-10-02T05:18:03-04:00 Bump terminfo submodule to 0.4.1.5 Closes #20307. - - - - - cb862ecf by Andreas Schwab at 2021-10-02T05:18:40-04:00 CmmToLlvm: Sign/Zero extend parameters for foreign calls on RISC-V Like S390 and PPC64, RISC-V requires parameters for foreign calls to be extended to full words. - - - - - 0d455a18 by Richard Eisenberg at 2021-10-02T05:19:16-04:00 Use eqType, not tcEqType, in metavar kind check Close #20356. See addendum to Note [coreView vs tcView] in GHC.Core.Type for the details. Also killed old Note about metaTyVarUpdateOK, which has been gone for some time. test case: typecheck/should_fail/T20356 - - - - - 4264e74d by Ben Gamari at 2021-10-02T05:19:51-04:00 rts: Add missing write barriers in MVar wake-up paths Previously PerformPut failed to respect the non-moving collector's snapshot invariant, hiding references to an MVar and its new value by overwriting a stack frame without dirtying the stack. Fix this. PerformTake exhibited a similar bug, failing to dirty (and therefore mark) the blocked stack before mutating it. Closes #20399. - - - - - 040c347e by Ben Gamari at 2021-10-02T05:19:51-04:00 rts: Unify stack dirtiness check This fixes an inconsistency where one dirtiness check would not mask out the STACK_DIRTY flag, meaning it may also be affected by the STACK_SANE flag. - - - - - 4bdafb48 by Sylvain Henry at 2021-10-02T05:20:29-04:00 Add (++)/literal rule When we derive the Show instance of the big record in #16577, I get the following compilation times (with -O): Before: 0.91s After: 0.77s Metric Decrease: T19695 - - - - - 8b3d98ff by Sylvain Henry at 2021-10-02T05:21:07-04:00 Don't use FastString for UTF-8 encoding only - - - - - f4554f1d by Ben Gamari at 2021-10-03T14:23:36-04:00 ci: Use https:// transport and access token to push perf notes Previously we would push perf notes using a standard user and SSH key-based authentication. However, configuring SSH is unnecessarily fiddling. We now rather use HTTPS and a project access token. - - - - - 91cd1248 by Ben Gamari at 2021-10-03T14:23:45-04:00 ci/test-metrics: Clean up various bash quoting issues - - - - - ed0e29f1 by Ben Gamari at 2021-10-03T23:24:37-04:00 base: Update Unicode database to 14.0 Closes #20404. - - - - - e8693713 by Ben Gamari at 2021-10-03T23:25:11-04:00 configure: Fix redundant-argument warning from -no-pie check Modern clang versions are quite picky when it comes to reporting redundant arguments. In particular, they will warn when -no-pie is passed when no linking is necessary. Previously the configure script used a `$CC -Werror -no-pie -E` invocation to test whether `-no-pie` is necessary. Unfortunately, this meant that clang would throw a redundant argument warning, causing configure to conclude that `-no-pie` was not supported. We now rather use `$CC -Werror -no-pie`, ensuring that linking is necessary and avoiding this failure mode. Fixes #20463. - - - - - b3267fad by Sylvain Henry at 2021-10-04T08:28:23+00:00 Constant folding for negate (#20347) Only for small integral types for now. - - - - - 2308a130 by Vladislav Zavialov at 2021-10-04T18:44:07-04:00 Clean up HiePass constraints - - - - - 40c81dd2 by Matthew Pickering at 2021-10-04T23:45:11-04:00 ci: Run hadrian builds verbosely, but not tests This reduces the output from the testsuite to a more manageable level. Fixes #20432 - - - - - 347537a5 by Ben Gamari at 2021-10-04T23:45:46-04:00 compiler: Improve Haddocks of atomic MachOps - - - - - a0f44ceb by Ben Gamari at 2021-10-04T23:45:46-04:00 compiler: Fix racy ticker counter registration Previously registration of ticky entry counters was racy, performing a read-modify-write to add the new counter to the ticky_entry_ctrs list. This could result in the list becoming cyclic if multiple threads entered the same closure simultaneously. Fixes #20451. - - - - - a7629334 by Vladislav Zavialov at 2021-10-04T23:46:21-04:00 Bespoke TokenLocation data type The EpaAnnCO we were using contained an Anchor instead of EpaLocation, making it harder to work with. At the same time, using EpaLocation by itself isn't possible either, as we may have tokens without location information. Hence the new data type: data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation - - - - - a14d0e63 by sheaf at 2021-10-04T23:46:58-04:00 Bump TcLevel of failing kind equality implication Not bumping the TcLevel meant that we could end up trying to add evidence terms for the implication constraint created to wrap failing kind equalities (to avoid their deferral). fixes #20043 - - - - - 48b0f17a by sheaf at 2021-10-04T23:47:35-04:00 Add a regression test for #17723 The underlying bug was fixed by b8d98827, see MR !2477 - - - - - 5601b9e2 by Matthías Páll Gissurarson at 2021-10-05T03:18:39-04:00 Speed up valid hole-fits by adding early abort and checks. By adding an early abort flag in `TcSEnv`, we can fail fast in the presence of insoluble constraints. This helps us avoid a lot of work in valid hole-fits, and we geta massive speed-up by avoiding a lot of useless work solving constraints that never come into play. Additionally, we add a simple check for degenerate hole types, such as when the type of the hole is an immutable type variable (as is the case when the hole is completely unconstrained). Then the only valid fits are the locals, so we can ignore the global candidates. This fixes #16875 - - - - - 298df16d by Krzysztof Gogolewski at 2021-10-05T03:19:14-04:00 Reject type family equation with wrong name (#20260) We should reject "type family Foo where Bar = ()". This check was done in kcTyFamInstEqn but not in tcTyFamInstEqn. I factored out arity checking, which was duplicated. - - - - - 643b6f01 by Sebastian Graf at 2021-10-05T14:32:51-04:00 WorkWrap: Nuke CPR signatures of join points (#18824) In #18824 we saw that the Simplifier didn't nuke a CPR signature of a join point when it pushed a continuation into it when it better should have. But join points are local, mostly non-exported bindings. We don't use their CPR signature anyway and would discard it at the end of the Core pipeline. Their main purpose is to propagate CPR info during CPR analysis and by the time worker/wrapper runs the signature will have served its purpose. So we zap it! Fixes #18824. - - - - - b4c0cc36 by Sebastian Graf at 2021-10-05T14:32:51-04:00 Simplifier: Get rid of demand zapping based on Note [Arity decrease] The examples in the Note were inaccurate (`$s$dm` has arity 1 and that seems OK) and the code didn't actually nuke the demand *signature* anyway. Specialise has to nuke it, but it starts from a clean IdInfo anyway (in `newSpecIdM`). So I just deleted the code. Fixes #20450. - - - - - cd1b016f by Sebastian Graf at 2021-10-05T14:32:51-04:00 CprAnal: Activate Sum CPR for local bindings We've had Sum CPR (#5075) for top-level bindings for a couple of years now. That begs the question why we didn't also activate it for local bindings, and the reasons for that are described in `Note [CPR for sum types]`. Only that it didn't make sense! The Note said that Sum CPR would destroy let-no-escapes, but that should be a non-issue since we have syntactic join points in Core now and we don't WW for them (`Note [Don't w/w join points for CPR]`). So I simply activated CPR for all bindings of sum type, thus fixing #5075 and \#16570. NoFib approves: ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- comp_lab_zift -0.0% +0.7% fluid +1.7% +0.7% reptile +0.1% +0.1% -------------------------------------------------------------------------------- Min -0.0% -0.2% Max +1.7% +0.7% Geometric Mean +0.0% +0.0% ``` There were quite a few metric decreases on the order of 1-4%, but T6048 seems to regress significantly, by 26.1%. WW'ing for a `Just` constructor and the nested data type meant additional Simplifier iterations and a 30% increase in term sizes as well as a 200-300% in type sizes due to unboxed 9-tuples. There's not much we can do about it, I'm afraid: We're just doing much more work there. Metric Decrease: T12425 T18698a T18698b T20049 T9020 WWRec Metric Increase: T6048 - - - - - 000f2a30 by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Address some Foldable documentation nits - Add link to laws from the class head - Simplify wording of left/right associativity intro paragraph - Avoid needless mention of "endomorphisms" - - - - - 7059a729 by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Add laws link and tweak Traversable class text - - - - - 43358ab9 by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Note linear `elem` cost This is a writeup of the state of play for better than linear `elem` via a helper type class. - - - - - 56899c8d by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Note elem ticket 20421 - - - - - fb6b772f by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Minor wording tweaks/fixes - - - - - f49c7012 by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Adopt David Feuer's explantion of foldl' via foldr - - - - - 5282eaa1 by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Explain Endo, Dual, ... in laws - - - - - f52df067 by Alfredo Di Napoli at 2021-10-05T14:34:04-04:00 Make GHC.Utils.Error.Validity type polymorphic This commit makes the `Validity` type polymorphic: ``` data Validity' a = IsValid -- ^ Everything is fine | NotValid a -- ^ A problem, and some indication of why -- | Monomorphic version of @Validity'@ specialised for 'SDoc's. type Validity = Validity' SDoc ``` The type has been (provisionally) renamed to Validity' to not break existing code, as the monomorphic `Validity` type is quite pervasive in a lot of signatures in GHC. Why having a polymorphic Validity? Because it carries the evidence of "what went wrong", but the old type carried an `SDoc`, which clashed with the new GHC diagnostic infrastructure (#18516). Having it polymorphic it means we can carry an arbitrary, richer diagnostic type, and this is very important for things like the `checkOriginativeSideConditions` function, which needs to report the actual diagnostic error back to `GHC.Tc.Deriv`. It also generalises Validity-related functions to be polymorphic in @a at . - - - - - ac275f42 by Alfredo Di Napoli at 2021-10-05T14:34:04-04:00 Eradicate TcRnUnknownMessage from GHC.Tc.Deriv This (big) commit finishes porting the GHC.Tc.Deriv module to support the new diagnostic infrastructure (#18516) by getting rid of the legacy calls to `TcRnUnknownMessage`. This work ended up being quite pervasive and touched not only the Tc.Deriv module but also the Tc.Deriv.Utils and Tc.Deriv.Generics module, which needed to be adapted to use the new infrastructure. This also required generalising `Validity`. More specifically, this is a breakdown of the work done: * Add and use the TcRnUselessTypeable data constructor * Add and use TcRnDerivingDefaults data constructor * Add and use the TcRnNonUnaryTypeclassConstraint data constructor * Add and use TcRnPartialTypeSignatures * Add T13324_compile2 test to test another part of the TcRnPartialTypeSignatures diagnostic * Add and use TcRnCannotDeriveInstance data constructor, which introduces a new data constructor to TcRnMessage called TcRnCannotDeriveInstance, which is further sub-divided to carry a `DeriveInstanceErrReason` which explains the reason why we couldn't derive a typeclass instance. * Add DerivErrSafeHaskellGenericInst data constructor to DeriveInstanceErrReason * Add DerivErrDerivingViaWrongKind and DerivErrNoEtaReduce * Introduce the SuggestExtensionInOrderTo Hint, which adds (and use) a new constructor to the hint type `LanguageExtensionHint` called `SuggestExtensionInOrderTo`, which can be used to give a bit more "firm" recommendations when it's obvious what the required extension is, like in the case for the `DerivingStrategies`, which automatically follows from having enabled both `DeriveAnyClass` and `GeneralizedNewtypeDeriving`. * Wildcard-free pattern matching in mk_eqn_stock, which removes `_` in favour of pattern matching explicitly on `CanDeriveAnyClass` and `NonDerivableClass`, because that determine whether or not we can suggest to the user `DeriveAnyClass` or not. - - - - - 52400ebb by Simon Peyton Jones at 2021-10-05T14:34:39-04:00 Ensure top-level binders in scope in SetLevels Ticket #20200 (the Agda failure) showed another case in which lookupIdSubst would fail to find a local Id in the InScopeSet. This time it was because SetLevels was given a program in which the top-level bindings were not in dependency order. The Simplifier (see Note [Glomming] in GHC.Core.Opt.Occuranal) and the specialiser (see Note [Top level scope] in GHC.Core.Opt.Specialise) may both produce top-level bindings where an early binding refers to a later one. One solution would be to run the occurrence analyser again to put them all in the right order. But a simpler one is to make SetLevels OK with this input by bringing all top-level binders into scope at the start. That's what this patch does. - - - - - 11240b74 by Sylvain Henry at 2021-10-05T14:35:17-04:00 Constant folding for (.&.) maxBound (#20448) - - - - - 29ee04f3 by Zubin Duggal at 2021-10-05T14:35:52-04:00 docs: Clarify documentation of `getFileSystemEncoding` (#20344) It may not always be a Unicode encoding - - - - - 435ff398 by Mann mit Hut at 2021-10-06T00:11:07-04:00 Corrected types of thread ids obtained from the RTS While the thread ids had been changed to 64 bit words in e57b7cc6d8b1222e0939d19c265b51d2c3c2b4c0 the return type of the foreign import function used to retrieve these ids - namely 'GHC.Conc.Sync.getThreadId' - was never updated accordingly. In order to fix that this function returns now a 'CUULong'. In addition to that the types used in the thread labeling subsystem were adjusted as well and several format strings were modified throughout the whole RTS to display thread ids in a consistent and correct way. Fixes #16761 - - - - - 89e98bdf by Alan Zimmerman at 2021-10-06T00:11:42-04:00 EPA: Remove duplicate AnnOpenP/AnnCloseP in DataDecl The parens EPAs were added in the tyvars where they belong, but also at the top level of the declaration. Closes #20452 - - - - - fc4c7ffb by Ryan Scott at 2021-10-06T00:12:17-04:00 Remove the Maybe in primRepName's type There's no need for this `Maybe`, as it will always be instantiated to `Just` in practice. Fixes #20482. - - - - - 4e91839a by sheaf at 2021-10-06T00:12:54-04:00 Add a regression test for #13233 This test fails on GHC 8.0.1, only when profiling is enabled, with the error: ghc: panic! (the 'impossible' happened) kindPrimRep.go a_12 This was fixed by commit b460d6c9. - - - - - 7fc986e1 by Sebastian Graf at 2021-10-06T00:13:29-04:00 CprAnal: Two regression tests For #16040 and #2387. - - - - - 9af29e7f by Matthew Pickering at 2021-10-06T10:57:24-04:00 Disable -dynamic-too if -dynamic is also passed Before if you passed both options then you would generate two identical hi/dyn_hi and o/dyn_o files, both in the dynamic way. It's better to warn this is happening rather than duplicating the work and causing potential confusion. -dynamic-too should only be used with -static. Fixes #20436 - - - - - a466b024 by sheaf at 2021-10-06T10:58:03-04:00 Improve overlap error for polykinded constraints There were two problems around `mkDictErr`: 1. An outdated call to `flattenTys` meant that we missed out on some instances. As we no longer flatten type-family applications, the logic is obsolete and can be removed. 2. We reported "out of scope" errors in a poly-kinded situation because `BoxedRep` and `Lifted` were considered out of scope. We fix this by using `pretendNameIsInScope`. fixes #20465 - - - - - b041fc6e by Ben Gamari at 2021-10-07T03:40:49-04:00 hadrian: Generate ghcii.sh in binary distributions Technically we should probably generate this in the in-place build tree as well, but I am not bothering to do so here as ghcii.sh will be removed in 9.4 when WinIO becomes the default anyways (see #12720). Fixes #19339. - - - - - 75a766a3 by Ben Gamari at 2021-10-07T03:40:49-04:00 hadrian: Fix incorrect ticket reference This was supposed to refer to #20253. - - - - - 62157287 by Teo Camarasu at 2021-10-07T03:41:27-04:00 fix non-moving gc heap space requirements estimate The space requirements of the non-moving gc are comparable to the compacting gc, not the copying gc. The copying gc requires a much larger overhead. Fixes #20475 - - - - - e82c8dd2 by Joachim Breitner at 2021-10-07T03:42:01-04:00 Fix rst syntax mistakes in release notes - - - - - 358f6222 by Benjamin Maurer at 2021-10-07T03:42:36-04:00 Removed left-over comment from `nonDetEltsUFM`-removal in `seqEltsUFM`. - - - - - 0cf23263 by Alan Zimmerman at 2021-10-07T03:43:11-04:00 EPA: Add comments to EpaDelta The EpaDelta variant of EpaLocation cannot be sorted by location. So we capture any comments that need to be printed between the prior output and this location, when creating an EpaDelta offset in ghc-exactprint. And make the EpaLocation fields strict. - - - - - e1d02fb0 by Sylvain Henry at 2021-10-07T20:20:01-04:00 Bignum: allow naturalEq#/Ne# to inline (#20361) We now perform constant folding on bigNatEq# instead. - - - - - 44886aab by Sylvain Henry at 2021-10-07T20:20:01-04:00 Bignum: allow inlining of naturalEq/Ne/Gt/Lt/Ge/Le/Compare (#20361) Perform constant folding on bigNatCompare instead. Some functions of the Enum class for Natural now need to be inlined explicitly to be specialized at call sites (because `x > lim` for Natural is inlined and the resulting function is a little too big to inline). If we don't do this, T17499 runtime allocations regresses by 16%. - - - - - 3a5a5c85 by Sylvain Henry at 2021-10-07T20:20:01-04:00 Bignum: allow naturalToWordClamp/Negate/Signum to inline (#20361) We don't need built-in rules now that bignum literals (e.g. 123 :: Natural) match with their constructors (e.g. NS 123##). - - - - - 714568bb by Sylvain Henry at 2021-10-07T20:20:01-04:00 Bignum: remove outdated comment - - - - - 4d44058d by Sylvain Henry at 2021-10-07T20:20:01-04:00 Bignum: transfer NOINLINE from Natural to BigNat - - - - - 01f5324f by Joachim Breitner at 2021-10-07T20:20:36-04:00 Recover test case for T11547 commit 98c7749 has reverted commit 59d7ee53, including the test that that file added. That test case is still valuable, so I am re-adding it. I add it with it’s current (broken) behavior so that whoever fixes it intentionally or accidentially will notice and then commit the actual desired behavior (which is kinda unspecified, see https://gitlab.haskell.org/ghc/ghc/-/issues/20455#note_382030) - - - - - 3d31f11e by Sylvain Henry at 2021-10-08T13:08:16-04:00 Don't link plugins' units with target code (#20218) Before this patch, plugin units were linked with the target code even when the unit was passed via `-plugin-package`. This is an issue to support plugins in cross-compilers (plugins are definitely not ABI compatible with target code). We now clearly separate unit dependencies for plugins and unit dependencies for target code and only link the latter ones. We've also added a test to ensure that plugin units passed via `-package` are linked with target code so that `thNameToGhcName` can still be used in plugins that need it (see T20218b). - - - - - 75aea732 by Joachim Breitner at 2021-10-08T13:08:51-04:00 New test case: Variant of T14052 with data type definitions previous attempts at fixing #11547 and #20455 were reverted because they showed some quadratic behaviour, and the test case T15052 was added to catch that. I believe that similar quadratic behavor can be triggered with current master, by using type definitions rather than value definitions, so this adds a test case similar to T14052. I have hopes that my attempts at fixing #11547 will lead to code that avoid the quadratic increase here. Or not, we will see. In any case, having this in `master` and included in future comparisons will be useful. - - - - - 374a718e by Teo Camarasu at 2021-10-08T18:09:56-04:00 Fix nonmoving gen label in gc stats report The current code assumes the non-moving generation is always generation 1, but this isn't the case if the amount of generations is greater than 2 Fixes #20461 - - - - - a37275a3 by Matthew Pickering at 2021-10-08T18:10:31-04:00 ci: Remove BROKEN_TESTS for x86 darwin builds The tests Capi_Ctype_001 Capi_Ctype_002 T12010 pass regularly on CI so let's mark them unbroken and hopefully then we can fix #20013. - - - - - e6838872 by Matthew Pickering at 2021-10-08T18:10:31-04:00 ci: Expect x86-darwin to pass Closes #20013 - - - - - 1f160cd9 by Matthew Pickering at 2021-10-08T18:10:31-04:00 Normalise output of T20199 test - - - - - 816d2561 by CarrieMY at 2021-10-08T18:11:08-04:00 Fix -E -fno-code undesirable interactions #20439 - - - - - 55a6377a by Matthew Pickering at 2021-10-08T18:11:43-04:00 code gen: Disable dead code elimination when -finfo-table-map is enabled It's important that when -finfo-table-map is enabled that we generate IPE entries just for those info tables which are actually used. To this end, the info tables which are used are collected just before code generation starts and entries only created for those tables. Not accounted for in this scheme was the dead code elimination in the native code generator. When compiling GHC this optimisation removed an info table which had an IPE entry which resulting in the following kind of linker error: ``` /home/matt/ghc-with-debug/_build/stage1/lib/../lib/x86_64-linux-ghc-9.3.20210928/libHSCabal-3.5.0.0-ghc9.3.20210928.so: error: undefined reference to '.Lc5sS_info' /home/matt/ghc-with-debug/_build/stage1/lib/../lib/x86_64-linux-ghc-9.3.20210928/libHSCabal-3.5.0.0-ghc9.3.20210928.so: error: undefined reference to '.Lc5sH_info' /home/matt/ghc-with-debug/_build/stage1/lib/../lib/x86_64-linux-ghc-9.3.20210928/libHSCabal-3.5.0.0-ghc9.3.20210928.so: error: undefined reference to '.Lc5sm_info' collect2: error: ld returned 1 exit status `cc' failed in phase `Linker'. (Exit code: 1) Development.Shake.cmd, system command failed ``` Unfortunately, by the time this optimisation happens the structure of the CmmInfoTable has been lost, we only have the generated code for the info table to play with so we can no longer just collect all the used info tables and generate the IPE map. This leaves us with two options: 1. Return a list of the names of the discarded info tables and then remove them from the map. This is awkward because we need to do code generation for the map as well. 2. Just disable this small code size optimisation when -finfo-table-map is enabled. The option produces very big object files anyway. Option 2 is much easier to implement and means we don't have to thread information around awkwardly. It's at the cost of slightly larger object files (as dead code is not eliminated). Disabling this optimisation allows an IPE build of GHC to complete successfully. Fixes #20428 - - - - - a76409c7 by Andrei Barbu at 2021-10-08T19:45:29-04:00 Add defaulting plugins. Like the built-in type defaulting rules these plugins can propose candidates to resolve ambiguous type variables. Machine learning and other large APIs like those for game engines introduce new numeric types and other complex typed APIs. The built-in defaulting mechanism isn't powerful enough to resolve ambiguous types in these cases forcing users to specify minutia that they might not even know how to do. There is an example defaulting plugin linked in the documentation. Applications include defaulting the device a computation executes on, if a gradient should be computed for a tensor, or the size of a tensor. See https://github.com/ghc-proposals/ghc-proposals/pull/396 for details. - - - - - 31983ab4 by sheaf at 2021-10-09T04:46:05-04:00 Reject GADT pattern matches in arrow notation Tickets #20469 and #20470 showed that the current implementation of arrows is not at all up to the task of supporting GADTs: GHC produces ill-scoped Core programs because it doesn't propagate the evidence introduced by a GADT pattern match. For the time being, we reject GADT pattern matches in arrow notation. Hopefully we are able to add proper support for GADTs in arrows in the future. - - - - - a356bd56 by Matthew Pickering at 2021-10-10T15:07:52+02:00 driver: Fix assertion failure on self-import Fixes #20459 - - - - - 245ab166 by Ben Gamari at 2021-10-10T17:55:10-04:00 hadrian: Include Cabal flags in verbose configure output - - - - - 9f9d6280 by Zejun Wu at 2021-10-12T01:39:53-04:00 Derive Eq instance for the HieTypeFix type We have `instance Eq a => Eq (HieType a)` already. This instance can be handy when we want to impement a function to find all `fromIntegral :: a -> a` using `case ty of { Roll (HFunTy _ a b) -> a == b; _ -> False }`. - - - - - 8d6de541 by Ben Gamari at 2021-10-12T01:40:29-04:00 nonmoving: Fix and factor out mark_trec_chunk We need to ensure that the TRecChunk itself is marked, in addition to the TRecs it contains. - - - - - aa520ba1 by Ben Gamari at 2021-10-12T01:40:29-04:00 rts/nonmoving: Rename mark_* to trace_* These functions really do no marking; they merely trace pointers. - - - - - 2c02ea8d by Ben Gamari at 2021-10-12T01:40:29-04:00 rts/primops: Fix write barrier in stg_atomicModifyMutVarzuzh Previously the call to dirty_MUT_VAR in stg_atomicModifyMutVarzuzh was missing its final argument. Fixes #20414. - - - - - 2e0c13ab by Ben Gamari at 2021-10-12T01:40:29-04:00 rts/nonmoving: Enable selector optimisation by default - - - - - 2c06720e by GHC GitLab CI at 2021-10-12T01:41:04-04:00 rts/Linker: Fix __dso_handle handling Previously the linker's handling of __dso_handle was quite wrong. Not only did we claim that __dso_handle could be NULL when statically linking (which it can not), we didn't even implement this mislead theory faithfully and instead resolved the symbol to a random pointer. This lead to the failing relocations on AArch64 noted in #20493. Here we try to implement __dso_handle as a dynamic linker would do, choosing an address within the loaded object (specifically its start address) to serve as the object's handle. - - - - - 58223dfa by Carrie Xu at 2021-10-12T01:41:41-04:00 Add Hint to "Empty 'do' block" Error Message#20147 - - - - - 8e88ef36 by Carrie Xu at 2021-10-12T01:41:41-04:00 Change affected tests stderr - - - - - 44384696 by Zubin Duggal at 2021-10-12T01:42:15-04:00 driver: Share the graph of dependencies We want to share the graph instead of recomputing it for each key. - - - - - e40feab0 by Matthew Pickering at 2021-10-12T01:42:50-04:00 Make ms_ghc_prim_import field strict If you don't promptly force this field then it ends up retaining a lot of data structures related to parsing. For example, the following retaining chain can be observed when using GHCi. ``` PState 0x4289365ca0 0x4289385d68 0x4289385db0 0x7f81b37a7838 0x7f81b3832fd8 0x4289365cc8 0x4289365cd8 0x4289365cf0 0x4289365cd8 0x4289365d08 0x4289385e48 0x7f81b4e4c290 0x7f818f63f440 0x7f818f63f440 0x7f81925ccd18 0x7f81b4e41230 0x7f818f63f440 0x7f81925ccd18 0x7f818f63f4a8 0x7f81b3832fd8 0x7f81b3832fd8 0x4289365d20 0x7f81b38233b8 0 19 <PState:GHC.Parser.Lexer:_build-ipe/stage1/compiler/build/GHC/Parser/Lexer.hs:3779:46> _thunk( ) 0x4289384230 0x4289384160 <([LEpaComment], [LEpaComment]):GHC.Parser.Lexer:> _thunk( ) 0x4289383250 <EpAnnComments:GHC.Parser.Lexer:compiler/GHC/Parser/Lexer.x:2306:19-40> _thunk( ) 0x4289399850 0x7f818f63f440 0x4289399868 <SrcSpanAnnA:GHC.Parser:_build-ipe/stage1/compiler/build/GHC/Parser.hs:12527:13-30> L 0x4289397600 0x42893975a8 <GenLocated:GHC.Parser:_build-ipe/stage1/compiler/build/GHC/Parser.hs:12527:32> 0x4289c4e8c8 : 0x4289c4e8b0 <[]:GHC.Parser.Header:compiler/GHC/Parser/Header.hs:104:36-54> (0x4289c4da70,0x7f818f63f440) <(,):GHC.Parser.Header:compiler/GHC/Parser/Header.hs:104:36-54> _thunk( ) 0x4289c4d030 <Bool:GHC.Parser.Header:compiler/GHC/Parser/Header.hs:(112,22)-(115,27)> ExtendedModSummary 0x422e9c8998 0x7f81b617be78 0x422e9c89b0 0x4289c4c0c0 0x7f81925ccd18 0x7f81925ccd18 0x7f81925ccd18 0x7f81925ccd18 0x7f818f63f440 0x4289c4c0d8 0x4289c4c0f0 0x7f81925ccd18 0x422e9c8a20 0x4289c4c108 0x4289c4c730 0x7f818f63f440 <ExtendedModSummary:GHC.Driver.Make:compiler/GHC/Driver/Make.hs:2041:30-38> ModuleNode 0x4289c4b850 <ModuleGraphNode:GHC.Unit.Module.Graph:compiler/GHC/Unit/Module/Graph.hs:139:14-36> 0x4289c4b590 : 0x4289c4b578 <[]:GHC.Unit.Module.Graph:compiler/GHC/Unit/Module/Graph.hs:139:31-36> ModuleGraph 0x4289c4b2f8 0x4289c4b310 0x4289c4b340 0x7f818f63f4a0 <ModuleGraph:GHC.Driver.Make:compiler/GHC/Driver/Make.hs:(242,19)-(244,40)> HscEnv 0x4289d9a4a8 0x4289d9aad0 0x4289d9aae8 0x4217062a88 0x4217060b38 0x4217060b58 0x4217060b68 0x7f81b38a7ce0 0x4217060b78 0x7f818f63f440 0x7f818f63f440 0x4217062af8 0x4289d9ab10 0x7f81b3907b60 0x4217060c00 114 <HscEnv:GHC.Runtime.Eval:compiler/GHC/Runtime/Eval.hs:790:31-44> ``` - - - - - 5c266b59 by Ben Gamari at 2021-10-12T19:16:40-04:00 hadrian: Introduce `static` flavour - - - - - 683011c7 by Ben Gamari at 2021-10-12T19:16:40-04:00 gitlab-ci: Introduce static Alpine job - - - - - 9257abeb by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Drop :set from ghci scripts The ghci scripts for T9293 and ghci057 used `:set` to print the currently-set options. However, in neither case was this necessary to the correctness of the test and moreover it would introduce spurious platform-dependence (e.g. since `-fexternal-dynamic-refs` is set by default only on platforms that support dynamic linking). - - - - - 82a89df7 by Ben Gamari at 2021-10-12T19:16:40-04:00 rts/linker: Define _DYNAMIC when necessary Usually the dynamic linker would define _DYNAMIC. However, when dynamic linking is not supported (e.g. on musl) it is safe to define it to be NULL. - - - - - fcd970b5 by GHC GitLab CI at 2021-10-12T19:16:40-04:00 rts/linker: Resolve __fini_array_* symbols to NULL If the __fini_array_{start,end} symbols are not defined (e.g. as is often the case when linking against musl) then resolve them to NULL. - - - - - 852ec4f5 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Mark T13702 as requiring share libraries It fails on statically-built Alpine with ``` T13702.hs:1:1: error: Could not find module ‘Prelude’ Perhaps you haven't installed the "dyn" libraries for package ‘base-4.15.0.0’? Use -v (or `:set -v` in ghci) to see a list of the files searched for. | 1 | {-# LANGUAGE ForeignFunctionInterface #-} | ^ ``` - - - - - b604bfd9 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Mark ghcilink00[25] as requiring dynamic linking - - - - - d709a133 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Mark all ghci/linking/dyn tests as requiring dynamic linking - - - - - 99b8177a by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Mark T14931 as requiring dynamic linking - - - - - 2687f65e by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Compile safeInfered tests with -v0 This eliminates some spurious platform-dependence due to static linking (namely in UnsafeInfered02 due to dynamic-too). - - - - - 587d7e66 by Brian Jaress at 2021-10-12T19:16:40-04:00 documentation: flavours.md static details - - - - - 91cfe121 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Make recomp021 less environment-sensitive Suppress output from diff to eliminate unnecessary environmental-dependence. - - - - - dc094597 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Make T12600 more robust Previously we would depend upon `grep ... | head -n1`. In principle this should work, but on Alpine Linux `grep` complains when its stdout stream has been closed. - - - - - cdd45a61 by Ben Gamari at 2021-10-12T19:16:40-04:00 gitlab-ci: Mark more broken tests on Alpine - - - - - 9ebda74e by Ben Gamari at 2021-10-12T19:16:40-04:00 rts/RtsSymbols: Add environ - - - - - 08aa7a1d by Ben Gamari at 2021-10-12T19:16:40-04:00 rts/linker: Introduce a notion of strong symbols - - - - - 005b1848 by Ben Gamari at 2021-10-12T19:16:40-04:00 rts/RtsSymbols: Declare atexit as a strong symbol - - - - - 5987357b by Ben Gamari at 2021-10-12T19:16:40-04:00 rts/RtsSymbols: fini array - - - - - 9074b748 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Move big-obj test from ghci/linking/dyn to ghci/linking There was nothing dynamic about this test. - - - - - 3b1c12d3 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Fix overzealous command-line mangling Previously this attempt at suppressing make's -s flag would mangle otherwise valid arguments. - - - - - 05303f68 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Clean up dynlib support predicates Previously it was unclear whether req_shared_libs should require: * that the platform supports dynamic library loading, * that GHC supports dynamic linking of Haskell code, or * that the dyn way libraries were built Clarify by splitting the predicate into two: * `req_dynamic_lib_support` demands that the platform support dynamic linking * `req_dynamic_hs` demands that the GHC support dynamic linking of Haskell code on the target platform Naturally `req_dynamic_hs` cannot be true unless `req_dynamic_lib_support` is also true. - - - - - 9859eede by Ben Gamari at 2021-10-12T19:16:40-04:00 gitlab-ci: Bump docker images Bumps bootstrap compiler to GHC 9.0.1. - - - - - af5ed156 by Matthew Pickering at 2021-10-12T19:17:15-04:00 Make the OccName field of NotOrphan strict In GHCi, by default the ModIface is not written to disk, this can leave a thunk which retains a TyCon which ends up retaining a great deal more on the heap. For example, here is the retainer trace from ghc-debug. ``` ... many other closures ... <TyCon:GHC.Core.TyCon:compiler/GHC/Core/TyCon.hs:1755:34-97> Just 0x423162aaa8 <Maybe:GHC.Core.TyCon:compiler/GHC/Core/TyCon.hs:(1936,11)-(1949,13)> FamilyTyCon 0x4231628318 0x4210e06260 0x4231628328 0x4231628340 0x421730a398 0x4231628358 0x4231628380 0x4231628390 0x7f0f5a171d18 0x7f0f7b1d7850 0x42316283a8 0x7f0f7b1d7830 <TyCon:GHC.Core.TyCon:compiler/GHC/Cor e/TyCon.hs:1948:30-32> _thunk( ) 0x4231624000 <OccName:GHC.Iface.Make:compiler/GHC/Iface/Make.hs:724:22-43> NotOrphan 0x42357d8ed8 <IsOrphan:GHC.Iface.Make:compiler/GHC/Iface/Make.hs:724:12-43> IfaceFamInst 0x4210e06260 0x42359aed10 0x4210e0c6b8 0x42359aed28 <IfaceFamInst:GHC.Iface.Make:> ``` Making the field strict squashes this retainer leak when using GHCi. - - - - - 0c5d9ca8 by Matthew Pickering at 2021-10-12T19:17:15-04:00 Be more careful about retaining KnotVars It is quite easy to end up accidently retaining a KnotVars, which contains pointers to a stale TypeEnv because they are placed in the HscEnv. One place in particular we have to be careful is when loading a module into the EPS in `--make` mode, we have to remove the reference to KnotVars as otherwise the interface loading thunks will forever retain reference to the KnotVars which are live at the time the interface was loaded. These changes do not go as far as to enforce the invariant described in Note [KnotVar invariants] * At the end of upsweep, there should be no live KnotVars but at least improve the situation. This is left for future work (#20491) - - - - - 105e2711 by Matthew Pickering at 2021-10-12T19:17:15-04:00 driver: Pass hsc_env with empty HPT into upsweep Otherwise you end up retaining the whole old HPT when reloading in GHCi. - - - - - 7215f6de by Matthew Pickering at 2021-10-12T19:17:15-04:00 Make fields of Linkable strict The Module field can end up retaining part of a large structure and is always calculated by projection. - - - - - 053d9deb by Matthew Pickering at 2021-10-12T19:17:15-04:00 Make the fields of MakeEnv strict There's no reason for them to be lazy, and in particular we would like to make sure the old_hpt field is evaluated. - - - - - 0d711791 by Matthew Pickering at 2021-10-12T19:17:15-04:00 More strictness around HomePackageTable This patch makes some operations to do with HomePackageTable stricter * Adding a new entry into the HPT would not allow the old HomeModInfo to be collected because the function used by insertWith wouldn't be forced. * We're careful to force the new MVar value before it's inserted into the global MVar as otherwise we retain references to old entries. - - - - - ff0409d0 by Matthew Pickering at 2021-10-12T19:17:15-04:00 driver: Filter out HPT modules **before** typecheck loop It's better to remove the modules first before performing the typecheckLoop as otherwise you can end up with thunks which reference stale HomeModInfo which are difficult to force due to the knot-tie. - - - - - c2ce1b17 by Matthew Pickering at 2021-10-12T19:17:15-04:00 Add GHCi recompilation performance test - - - - - 82938981 by Matthew Pickering at 2021-10-12T19:17:15-04:00 Force name_exe field to avoid retaining entire UnitEnv (including whole HPT) Not forcing this one place will result in GHCi using 2x memory on a reload. - - - - - 90f06a0e by Haochen Tong at 2021-10-12T19:17:53-04:00 Check for libatomic dependency for atomic operations Some platforms (e.g. RISC-V) require linking against libatomic for some (e.g. sub-word-sized) atomic operations. Fixes #19119. - - - - - 234bf368 by Haochen Tong at 2021-10-12T19:17:53-04:00 Move libatomic check into m4/fp_gcc_supports_atomics.m4 - - - - - 4cf43b2a by Haochen Tong at 2021-10-12T19:17:53-04:00 Rename fp_gcc_supports__atomics to fp_cc_supports__atomics - - - - - 0aae1b4e by Joachim Breitner at 2021-10-13T01:07:45+00:00 shadowNames: Accept an OccName, not a GreName previously, the `shadowNames` function would take `[GreName]`. This has confused me for two reasons: * Why `GreName` and not `Name`? Does the difference between a normal name and a field name matter? The code of `shadowNames` shows that it does not, but really its better if the type signatures says so. * Why `Name` and not `OccName`? The point of `shadowNames` is to shadow _unqualified names_, at least in the two use cases I am aware of (names defined on the GHCI prompt or in TH splices). The code of `shadowNames` used to have cases that peek at the module of the given name and do something if that module appears in the `GlobalRdrElt`, but I think these cases are dead code, I don’t see how they could occur in the above use cases. Also, I replaced them with `errors` and GHC would still validate. Hence removing this code (yay!) This change also allows `shadowNames` to accept an `OccSet` instead, which allows for a faster implemenation; I’ll try that separately. This in stead might help with !6703. - - - - - 19cd403b by Norman Ramsey at 2021-10-13T03:32:21-04:00 Define and export Outputable instance for StgOp - - - - - 58bd0cc1 by Zubin Duggal at 2021-10-13T13:50:10+05:30 ci: build validate-x86_64-linux-deb9-debug with hyperlinked source (#20067) - - - - - 4536e8ca by Zubin Duggal at 2021-10-13T13:51:00+05:30 hadrian, testsuite: Teach Hadrian to query the testsuite driver for dependencies Issues #19072, #17728, #20176 - - - - - 60d3e33d by Zubin Duggal at 2021-10-13T13:51:03+05:30 hadrian: Fix location for haddocks in installed pkgconfs - - - - - 337a31db by Zubin Duggal at 2021-10-13T13:51:03+05:30 testsuite: Run haddock tests on out of tree compiler - - - - - 8c224b6d by Zubin Duggal at 2021-10-13T13:51:03+05:30 ci: test in-tree compiler in hadrian - - - - - 8d5a5ecf by Zubin Duggal at 2021-10-13T13:51:03+05:30 hadrian: avoid building check-{exact,ppr} and count-deps when the tests don't need them hadrian: build optional dependencies with test compiler - - - - - d0e87d0c by Zubin Duggal at 2021-10-13T13:51:03+05:30 testsuite: remove 'req_smp' from testwsdeque - - - - - 3c0e60b8 by Zubin Duggal at 2021-10-13T13:51:03+05:30 testsuite: strip windows line endings for haddock haddock: deterministic SCC Updates haddock submodule Metric Increase: haddock.Cabal haddock.base haddock.compiler - - - - - 64460b20 by Ben Gamari at 2021-10-13T18:44:12-04:00 distrib/configure: Add AC_CONFIG_MACRO_DIRS Sadly, autoconf cannot warn when it encounters an undefined macro and therefore this bug went unnoticed for altogether far too long. - - - - - e46edfcf by sheaf at 2021-10-13T18:44:49-04:00 Set logger flags in --backpack mode Backpack used to initialise the logger before obtaining the DynFlags. This meant that logging options (such as dump flags) were not set. Initialising the logger after the session flags have been set fixes the issue. fixes #20396 - - - - - df016e4e by Matthew Pickering at 2021-10-14T08:41:17-04:00 Make sure paths are quoted in install Makefile Previously it would fail with this error: ``` if [ -L wrappers/ghc ]; then echo "ghc is a symlink"; fi ghc is a symlink cp: target 'dir/bin/ghc' is not a directory make: *** [Makefile:197: install_wrappers] Error 1 ``` which is because the install path contains a space. Fixes #20506 - - - - - 7f2ce0d6 by Joachim Breitner at 2021-10-14T08:41:52-04:00 Move BreakInfo into own module while working on GHCi stuff, e.g. `GHC.Runtime.Eval.Types`, I observed a fair amount of modules being recompiled that I didn’t expect to depend on this, from byte code interpreters to linkers. Turns out that the rather simple `BreakInfo` type is all these modules need from the `GHC.Runtime.Eval.*` hierarchy, so by moving that into its own file we make the dependency tree wider and shallower, which is probably worth it. - - - - - 557d26fa by Ziyang Liu at 2021-10-14T14:32:57-04:00 Suggest -dynamic-too in failNonStd when applicable I encountered an error that says ``` Cannot load -dynamic objects when GHC is built the normal way To fix this, either: (1) Use -fexternal-interpreter, or (2) Build the program twice: once the normal way, and then with -dynamic using -osuf to set a different object file suffix. ``` Or it could say ``` (2) Use -dynamic-too ``` - - - - - f450e948 by Joachim Breitner at 2021-10-14T14:33:32-04:00 fuzzyLookup: More deterministic order else the output may depend on the input order, which seems it may depend on the concrete Uniques, which is causing headaches when including test cases about that. - - - - - 8b7f5424 by Alan Zimmerman at 2021-10-14T14:34:07-04:00 EPA: Preserve semicolon order in annotations Ensure the AddSemiAnn items appear in increasing order, so that if they are converted to delta format they are still in the correct order. Prior to this the exact printer sorted by Span, which is meaningless for EpaDelta locations. - - - - - 481e6b54 by Matthew Pickering at 2021-10-14T14:34:42-04:00 Some extra strictness in annotation fields Locations can be quite long-lived so it's important that things which live in locations, such as annotations are forced promptly. Otherwise they end up retaining the entire PState, as evidenced by this retainer trace: ``` PState 0x4277ce6cd8 0x4277ce6d00 0x7f61f12d37d8 0x7f61f12d37d8 0x7f61f135ef78 0x4277ce6d48 0x4277ce6d58 0x4277ce6d70 0x4277ce6d58 0x4277ce6d88 0x4277ce6da0 0x7f61f29782f0 0x7f61cd16b440 0x7f61cd16b440 0x7f61d00f8d18 0x7f61f296d290 0x7f61cd16b440 0x7f61d00f8d18 0x7f61cd16b4a8 0x7f61f135ef78 0x4277ce6db8 0x4277ce6dd0 0x7f61f134f358 0 3 <PState:GHC.Parser.Lexer:_build-ipe/stage1/compiler/build/GHC/Parser/Lexer.hs:3779:46> _thunk( ) 0x4277ce6280 0x4277ce68a0 <([LEpaComment], [LEpaComment]):GHC.Parser.Lexer:> _thunk( ) 0x4277ce6568 <EpAnnComments:GHC.Parser.Lexer:compiler/GHC/Parser/Lexer.x:2306:19-40> _thunk( ) 0x4277ce62b0 0x4277ce62c0 0x4277ce6280 0x7f61f287fc58 <EpAnn AnnList:GHC.Parser:_build-ipe/stage1/compiler/build/GHC/Parser.hs:12664:13-32> SrcSpanAnn 0x4277ce6060 0x4277ce6048 <SrcSpanAnn':GHC.Parser:_build-ipe/stage1/compiler/build/GHC/Parser.hs:12664:3-35> L 0x4277ce4e70 0x428f8c9158 <GenLocated:GHC.Data.BooleanFormula:compiler/GHC/Data/BooleanFormula.hs:40:23-29> 0x428f8c8318 : 0x428f8c8300 <[]:GHC.Base:libraries/base/GHC/Base.hs:1316:16-29> Or 0x428f8c7890 <BooleanFormula:GHC.Data.BooleanFormula:compiler/GHC/Data/BooleanFormula.hs:40:23-29> IfConcreteClass 0x7f61cd16b440 0x7f61cd16b440 0x428f8c7018 0x428f8c7030 <IfaceClassBody:GHC.Iface.Make:compiler/GHC/Iface/Make.hs:(640,12)-(645,13)> ``` Making these few places strict is sufficient for now but there are perhaps more places which will need strictifying in future. ------------------------- Metric Increase: parsing001 ------------------------- - - - - - 7a8171bc by Tom Sydney Kerckhove at 2021-10-15T06:51:18+00:00 Insert warnings in the documentation of dangerous functions - - - - - 1cda768c by Joachim Breitner at 2021-10-15T18:15:36-04:00 GHC.Builtin.Uniques: Remove unused code a number of functions exported by this module are (no longer) used, so let’s remove them. In particular, it no longer seems to be the case that type variables have tag `'t'`, so removed the special handling when showing them. * the use of `initTyVarUnique` was removed in 7babb1 (with the notable commit message of "Before merging to HEAD we need to tidy up and write a proper commit message.") * `mkPseudoUniqueD`and `mkPseudoUniqueH` were added in 423d477, but never ever used? * `mkCoVarUnique` was added in 674654, but never ever used? - - - - - 88e913d4 by Oleg Grenrus at 2021-10-15T18:16:14-04:00 Null eventlog writer - - - - - bbb1f6da by Sylvain Henry at 2021-10-15T18:16:51-04:00 Hadrian: display command line above errors (#20490) - - - - - b6954f0c by Joachim Breitner at 2021-10-15T18:17:26-04:00 shadowNames: Use OccEnv a, not [OccName] this allows us to use a smarter implementation based on `Data.IntSet.differenceWith`, which should do less work. Also, it will unblock improvements to !6703. The `OccEnv a` really denotes a set of `OccName`s. We are not using `OccSet`, though, because that is an `OccEnv OccName`, and we in !6703 we want to use this with differently-valued `OccEnv`s. But `OccSet`s are readily and safely coerced into `OccEnv`s. There is no other use of `delLocalRdrEnvList` remaining, so removing that. - - - - - c9922a8e by Matthew Pickering at 2021-10-15T18:18:00-04:00 hadrian: Document lint targets Fixes #20508 - - - - - 65bf3992 by Matthew Pickering at 2021-10-17T14:06:08-04:00 ghci: Explicitly store and restore interface file cache In the old days the old HPT was used as an interface file cache when using ghci. The HPT is a `ModuleEnv HomeModInfo` and so if you were using hs-boot files then the interface file from compiling the .hs file would be present in the cache but not the hi-boot file. This used to be ok, because the .hi file used to just be a better version of the .hi-boot file, with more information so it was fine to reuse it. Now the source hash of a module is kept track of in the interface file and the source hash for the .hs and .hs-boot file are correspondingly different so it's no longer safe to reuse an interface file. I took the decision to move the cache management of interface files to GHCi itself, and provide an API where `load` can be provided with a list of interface files which can be used as a cache. An alternative would be to manage this cache somewhere in the HscEnv but it seemed that an API user should be responsible for populating and suppling the cache rather than having it managed implicitly. Fixes #20217 - - - - - 81740ce8 by sheaf at 2021-10-17T14:06:46-04:00 Introduce Concrete# for representation polymorphism checks PHASE 1: we never rewrite Concrete# evidence. This patch migrates all the representation polymorphism checks to the typechecker, using a new constraint form Concrete# :: forall k. k -> TupleRep '[] Whenever a type `ty` must be representation-polymorphic (e.g. it is the type of an argument to a function), we emit a new `Concrete# ty` Wanted constraint. If this constraint goes unsolved, we report a representation-polymorphism error to the user. The 'FRROrigin' datatype keeps track of the context of the representation-polymorphism check, for more informative error messages. This paves the way for further improvements, such as allowing type families in RuntimeReps and improving the soundness of typed Template Haskell. This is left as future work (PHASE 2). fixes #17907 #20277 #20330 #20423 #20426 updates haddock submodule ------------------------- Metric Decrease: T5642 ------------------------- - - - - - 19d1237e by Koz Ross at 2021-10-19T03:29:40-04:00 Fix infelicities in docs for lines, unlines, words, unwords - - - - - 3035d1a2 by Matthew Pickering at 2021-10-19T03:30:16-04:00 tests: Remove $(CABAL_MINIMAL_CONFIGURATION) from T16219 There is a latent issue in T16219 where -dynamic-too is enabled when compiling a signature file which causes us to enter the DT_Failed state because library-a-impl doesn't generate dyn_o files. Somehow this used to work in 8.10 (that also entered the DT_Failed state) We don't need dynamic object files when compiling a signature file but the code loads interfaces, and if dynamic-too is enabled then it will also try to load the dyn_hi file and check the two are consistent. There is another hack to do with this in `GHC.Iface.Recomp`. The fix for this test is to remove CABAL_MINIMAL_CONFIGURATION, which stops cabal building shared libraries by default. I'm of the opinion that the DT_Failed state indicates an error somewhere so we should hard fail rather than this confusing (broken) rerun logic. Whether this captures the original intent of #16219 is debateable, but it's not clear how it was supposed to work in the first place if the libraries didn't build dynamic object files. Module C imports module A, which is from a library where shared objects are not built so the test would never have worked anyway (if anything from A was used in a TH splice). - - - - - d25868b6 by Matthew Pickering at 2021-10-19T03:30:16-04:00 dynamic-too: Expand GHC.Iface.Recomp comment about the backpack hack - - - - - 837ce6cf by Matthew Pickering at 2021-10-19T03:30:16-04:00 driver: Check the correct flag to see if dynamic-too is enabled. We just need to check the flag here rather than read the variable which indicates whether dynamic-too compilation has failed. - - - - - 981f2c74 by Matthew Pickering at 2021-10-19T03:30:16-04:00 driver: Update cached DynFlags in ModSummary if we are enabling -dynamic-too - - - - - 1bc77a85 by Matthew Pickering at 2021-10-19T03:30:16-04:00 dynamic-too: Check the dynamic-too status in hscPipeline This "fixes" DT_Failed in --make mode, but only "fixes" because I still believe DT_Failed is pretty broken. - - - - - 51281e81 by Matthew Pickering at 2021-10-19T03:30:16-04:00 Add test for implicit dynamic too This test checks that we check for missing dynamic objects if dynamic-too is enabled implicitly by the driver. - - - - - 8144a92f by Matthew Pickering at 2021-10-19T03:30:16-04:00 WW: Use module name rather than filename for absent error messages WwOpts in WorkWrap.Utils initialised the wo_output_file field with the result of outputFile dflags. This is misguided because outputFile is only set when -o is specified, which is barely ever (and never in --make mode). It seems this is just used to add more context to an error message, a more appropriate thing to use I think would be a module name. Fixes #20438 - - - - - df419c1a by Matthew Pickering at 2021-10-19T03:30:16-04:00 driver: Cleanups related to ModLocation ModLocation is the data type which tells you the locations of all the build products which can affect recompilation. It is now computed in one place and not modified through the pipeline. Important locations will now just consult ModLocation rather than construct the dynamic object path incorrectly. * Add paths for dynamic object and dynamic interface files to ModLocation. * Always use the paths from mod location when looking for where to find any interface or object file. * Always use the paths in a ModLocation when deciding where to write an interface and object file. * Remove `dynamicOutputFile` and `dynamicOutputHi` functions which *calculated* (incorrectly) the location of `dyn_o` and `dyn_hi` files. * Don't set `outputFile_` and so-on in `enableCodeGenWhen`, `-o` and hence `outputFile_` should not affect the location of object files in `--make` mode. It is now sufficient to just update the ModLocation with the temporary paths. * In `hscGenBackendPipeline` don't recompute the `ModLocation` to account for `-dynamic-too`, the paths are now accurate from the start of the run. * Rename `getLocation` to `mkOneShotModLocation`, as that's the only place it's used. Increase the locality of the definition by moving it close to the use-site. * Load the dynamic interface from ml_dyn_hi_file rather than attempting to reconstruct it in load_dynamic_too. * Add a variety of tests to check how -o -dyno etc interact with each other. Some other clean-ups * DeIOify mkHomeModLocation and friends, they are all pure functions. * Move FinderOpts into GHC.Driver.Config.Finder, next to initFinderOpts. * Be more precise about whether we mean outputFile or outputFile_: there were many places where outputFile was used but the result shouldn't have been affected by `-dyno` (for example the filename of the resulting executable). In these places dynamicNow would never be set but it's still more precise to not allow for this possibility. * Typo fixes suffices -> suffixes in the appropiate places. - - - - - 3d6eb85e by Matthew Pickering at 2021-10-19T03:30:16-04:00 driver: Correct output of -fno-code and -dynamic-too Before we would print [1 of 3] Compiling T[boot] ( T.hs-boot, nothing, T.dyn_o ) Which was clearly wrong for two reasons. 1. No dynamic object file was produced for T[boot] 2. The file would be called T.dyn_o-boot if it was produced. Fixes #20300 - - - - - 753b921d by Matthew Pickering at 2021-10-19T03:30:16-04:00 Remove DT_Failed state At the moment if `-dynamic-too` fails then we rerun the whole pipeline as if we were just in `-dynamic` mode. I argue this is a misfeature and we should remove the so-called `DT_Failed` mode. In what situations do we fall back to `DT_Failed`? 1. If the `dyn_hi` file corresponding to a `hi` file is missing completely. 2. If the interface hash of `dyn_hi` doesn't match the interface hash of `hi`. What happens in `DT_Failed` mode? * The whole compiler pipeline is rerun as if the user had just passed `-dynamic`. * Therefore `dyn_hi/dyn_o` files are used which don't agree with the `hi/o` files. (As evidenced by `dynamicToo001` test). * This is very confusing as now a single compiler invocation has produced further `hi`/`dyn_hi` files which are different to each other. Why should we remove it? * In `--make` mode, which is predominately used `DT_Failed` does not work (#19782), there can't be users relying on this functionality. * In `-c` mode, the recovery doesn't fix the root issue, which is the `dyn_hi` and `hi` files are mismatched. We should instead produce an error and pass responsibility to the build system using `-c` to ensure that the prerequisites for `-dynamic-too` (dyn_hi/hi) files are there before we start compiling. * It is a misfeature to support use cases like `dynamicToo001` which allow you to mix different versions of dynamic/non-dynamic interface files. It's more likely to lead to subtle bugs in your resulting programs where out-dated build products are used rather than a deliberate choice. * In practice, people are usually compiling with `-dynamic-too` rather than separately with `-dynamic` and `-static`, so the build products always match and `DT_Failed` is only entered due to compiler bugs (see !6583) What should we do instead? * In `--make` mode, for home packages check during recompilation checking that `dyn_hi` and `hi` are both present and agree, recompile the modules if they do not. * For package modules, when loading the interface check that `dyn_hi` and `hi` are there and that they agree but fail with an error message if they are not. * In `--oneshot` mode, fail with an error message if the right files aren't already there. Closes #19782 #20446 #9176 #13616 - - - - - 7271bf78 by Joachim Breitner at 2021-10-19T03:30:52-04:00 InteractiveContext: Smarter caching when rebuilding the ic_rn_gbl_env The GlobalRdrEnv of a GHCI session changes in odd ways: New bindings are not just added "to the end", but also "in the middle", namely when changing the set of imports: These are treated as if they happened before all bindings from the prompt, even those that happened earlier. Previously, this meant that the `ic_rn_gbl_env` is recalculated from the `ic_tythings`. But this wasteful if `ic_tythings` has many entries that define the same unqualified name. By separately keeping track of a `GlobalRdrEnv` of all the locally defined things we can speed this operation up significantly. This change improves `T14052Type` by 60% (It used to be 70%, but it looks that !6723 already reaped some of the rewards). But more importantly, it hopefully unblocks #20455, becaues with this smarter caching, the change needed to fix that issue will no longer make `T14052` explode. I hope. It does regress `T14052` by 30%; caching isn’t free. Oh well. Metric Decrease: T14052Type Metric Increase: T14052 - - - - - 53c0e771 by Matthew Pickering at 2021-10-19T03:31:27-04:00 Add test for T20509 This test checks to see whether a signature can depend on another home module. Whether it should or not is up for debate, see #20509 for more details. - - - - - fdfb3b03 by Matthew Pickering at 2021-10-19T03:31:27-04:00 Make the fields of Target and TargetId strict Targets are long-lived through GHC sessions so we don't want to end up retaining In particular in 'guessTarget', the call to `unitIdOrHomeUnit` was retaining reference to an entire stale HscEnv, which in turn retained reference to a stale HomePackageTable. Making the fields strict forces that place promptly and helps ensure that mistakes like this don't happen again. - - - - - 877e6685 by Matthew Pickering at 2021-10-19T03:31:27-04:00 Temporary fix for leak with -fno-code (#20509) This hack inserted for backpack caused a very bad leak when using -fno-code where EPS entries would end up retaining stale HomePackageTables. For any interactive user, such as HLS, this is really bad as once the entry makes it's way into the EPS then it's there for the rest of the session. This is a temporary fix which "solves" the issue by filtering the HPT to only the part which is needed for the hack to work, but in future we want to separate out hole modules from the HPT entirely to avoid needing to do this kind of special casing. ------------------------- Metric Decrease: MultiLayerModulesDefsGhci ------------------------- - - - - - cfacac68 by Matthew Pickering at 2021-10-19T03:31:27-04:00 Add performance test for ghci, -fno-code and reloading (#20509) This test triggers the bad code path identified by #20509 where an entry into the EPS caused by importing Control.Applicative will retain a stale HomePackageTable. - - - - - 12d74ef7 by Richard Eisenberg at 2021-10-19T13:36:36-04:00 Care about specificity in pattern type args Close #20443. - - - - - 79c9c816 by Zubin Duggal at 2021-10-19T13:37:12-04:00 Don't print Shake Diagnostic messages (#20484) - - - - - f8ce38e6 by Emily Martins at 2021-10-19T22:21:26-04:00 Fix #19884: add warning to tags command, drop T10989 - - - - - d73131b9 by Ben Gamari at 2021-10-19T22:22:02-04:00 hadrian: Fix quoting in binary distribution installation Makefile Previously we failed to quote various paths in Hadrian's installation Makefile, resulting in #20506. - - - - - 949d7398 by Matthew Pickering at 2021-10-20T14:05:23-04:00 Add note about heap invariants [skip ci] At the moment the note just covers three important invariants but now there is a place to add more to if we think of them. - - - - - 2f75ffac by Ben Gamari at 2021-10-20T14:06:00-04:00 hadrian/doc: Add margin to staged-compilation figure - - - - - 5f274fbf by Ben Gamari at 2021-10-20T14:06:00-04:00 hadrian: Fix binary-dist support for cross-compilers Previously the logic which called ghc-pkg failed to account for the fact that the executable name may be prefixed with a triple. Moreover, the call must occur before we delete the settings file as ghc-pkg needs the latter. Fixes #20267. - - - - - 3e4b51ff by Matthew Pickering at 2021-10-20T14:06:36-04:00 Fix perf-nofib CI job The main change is to install the necessary build dependencies into an environment file using `caball install --lib`. Also updates the nofib submodule with a few fixes needed for the job to work. - - - - - ef92d889 by Matthew Pickering at 2021-10-20T14:07:12-04:00 Distribute HomeModInfo cache before starting upsweep This change means the HomeModInfo cache isn't retained until the end of upsweep and each cached interface can be collected immediately after its module is compiled. The result is lower peak memory usage when using GHCi. For Agda it reduced peak memory usage from about 1600M to 1200M. - - - - - 05b8a218 by Matthew Pickering at 2021-10-20T14:07:49-04:00 Make fields of GlobalRdrElt strict In order to do this I thought it was prudent to change the list type to a bag type to avoid doing a lot of premature work in plusGRE because of ++. Fixes #19201 - - - - - 0b575899 by Sylvain Henry at 2021-10-20T17:49:07-04:00 Bignum: constant folding for bigNatCompareWord# (#20361) - - - - - 758e0d7b by Sylvain Henry at 2021-10-20T17:49:07-04:00 Bignum: allow Integer predicates to inline (#20361) T17516 allocations increase by 48% because Integer's predicates are inlined in some Ord instance methods. These methods become too big to be inlined while they probably should: this is tracked in #20516. Metric Increase: T17516 - - - - - a901a1ae by Sylvain Henry at 2021-10-20T17:49:07-04:00 Bignum: allow Integer's signum to inline (#20361) Allow T12545 to increase because it only happens on CI with dwarf enabled and probably not related to this patch. Metric Increase: T12545 - - - - - 9ded1b17 by Matthew Pickering at 2021-10-20T17:49:42-04:00 Make sure ModIface values are still forced even if not written When we are not writing a ModIface to disk then the result can retain a lot of stuff. For example, in the case I was debugging the DocDeclsMap field was holding onto the entire HomePackageTable due to a single unforced thunk. Therefore, now if we're not going to write the interface then we still force deeply it in order to remove these thunks. The fields in the data structure are not made strict because when we read the field from the interface we don't want to load it immediately as there are parts of an interface which are unused a lot of the time. Also added a note to explain why not all the fields in a ModIface field are strict. The result of this is being able to load Agda in ghci and not leaking information across subsequent reloads. - - - - - 268857af by Matthew Pickering at 2021-10-20T17:50:19-04:00 ci: Move hlint jobs from quick-built into full-build This somewhat fixes the annoyance of not getting any "useful" feedback from a CI pipeline if you have a hlint failure. Now the hlint job runs in parallel with the other CI jobs so the feedback is recieved at the same time as other testsuite results. Fixes #20507 - - - - - f6f24515 by Joachim Breitner at 2021-10-20T17:50:54-04:00 instance Ord Name: Do not repeat default methods it is confusing to see what looks like it could be clever code, only to see that it does precisely the same thing as the default methods. Cleaning this up, to spare future readers the confusion. - - - - - 56b2b04f by Ziyang Liu at 2021-10-22T10:57:28-04:00 Document that `InScopeSet` is a superset of currently in-scope variables - - - - - 7f4e0e91 by Moritz Angermann at 2021-10-22T10:58:04-04:00 Do not sign extend CmmInt's unless negative. Might fix #20526. - - - - - 77c6f3e6 by sheaf at 2021-10-22T10:58:44-04:00 Use tcEqType in GHC.Core.Unify.uVar Because uVar used eqType instead of tcEqType, it was possible to accumulate a substitution that unified Type and Constraint. For example, a call to `tc_unify_tys` with arguments tys1 = [ k, k ] tys2 = [ Type, Constraint ] would first add `k = Type` to the substitution. That's fine, but then the second call to `uVar` would claim that the substitution also unifies `k` with `Constraint`. This could then be used to cause trouble, as per #20521. Fixes #20521 - - - - - fa5870d3 by Sylvain Henry at 2021-10-22T19:20:05-04:00 Add test for #19641 Now that Bignum predicates are inlined (!6696), we only need to add a test. Fix #19641 - - - - - 6fd7da74 by Sylvain Henry at 2021-10-22T19:20:44-04:00 Remove Indefinite We no longer need it after previous IndefUnitId refactoring. - - - - - 806e49ae by Sylvain Henry at 2021-10-22T19:20:44-04:00 Refactor package imports Use an (Raw)PkgQual datatype instead of `Maybe FastString` to represent package imports. Factorize the code that renames RawPkgQual into PkgQual in function `rnPkgQual`. Renaming consists in checking if the FastString is the magic "this" keyword, the home-unit unit-id or something else. Bump haddock submodule - - - - - 47ba842b by Haochen Tong at 2021-10-22T19:21:21-04:00 Fix compilerConfig stages Fix the call to compilerConfig because it accepts 1-indexed stage numbers. Also fixes `make stage=3`. - - - - - 621608c9 by Matthew Pickering at 2021-10-22T19:21:56-04:00 driver: Don't use the log queue abstraction when j = 1 This simplifies the code path for -j1 by not using the log queue queue abstraction. The result is that trace output isn't interleaved with other dump output like it can be with -j<N>. - - - - - dd2dba80 by Sebastian Graf at 2021-10-22T19:22:31-04:00 WorkWrap: `isRecDataCon` should not eta-reduce NewTyCon field tys (#20539) In #20539 we had a type ```hs newtype Measured a = Measured { unmeasure :: () -> a } ``` and `isRecDataCon Measured` recursed into `go_arg_ty` for `(->) ()`, because `unwrapNewTyConEtad_maybe` eta-reduced it. That triggered an assertion error a bit later. Eta reducing the field type is completely wrong to do here! Just call `unwrapNewTyCon_maybe` instead. Fixes #20539 and adds a regression test T20539. - - - - - 8300ca2e by Ben Gamari at 2021-10-24T01:26:11-04:00 driver: Export wWarningFlagMap A new feature requires Ghcide to be able to convert warnings to CLI flags (WarningFlag -> String). This is most easily implemented in terms of the internal function flagSpecOf, which uses an inefficient implementation based on linear search through a linked list. This PR derives Ord for WarningFlag, and replaces that list with a Map. Closes #19087. - - - - - 3bab222c by Sebastian Graf at 2021-10-24T01:26:46-04:00 DmdAnal: Implement Boxity Analysis (#19871) This patch fixes some abundant reboxing of `DynFlags` in `GHC.HsToCore.Match.Literal.warnAboutOverflowedLit` (which was the topic of #19407) by introducing a Boxity analysis to GHC, done as part of demand analysis. This allows to accurately capture ad-hoc unboxing decisions previously made in worker/wrapper in demand analysis now, where the boxity info can propagate through demand signatures. See the new `Note [Boxity analysis]`. The actual fix for #19407 is described in `Note [No lazy, Unboxed demand in demand signature]`, but `Note [Finalising boxity for demand signature]` is probably a better entry-point. To support the fix for #19407, I had to change (what was) `Note [Add demands for strict constructors]` a bit (now `Note [Unboxing evaluated arguments]`). In particular, we now take care of it in `finaliseBoxity` (which is only called from demand analaysis) instead of `wantToUnboxArg`. I also had to resurrect `Note [Product demands for function body]` and rename it to `Note [Unboxed demand on function bodies returning small products]` to avoid huge regressions in `join004` and `join007`, thereby fixing #4267 again. See the updated Note for details. A nice side-effect is that the worker/wrapper transformation no longer needs to look at strictness info and other bits such as `InsideInlineableFun` flags (needed for `Note [Do not unbox class dictionaries]`) at all. It simply collects boxity info from argument demands and interprets them with a severely simplified `wantToUnboxArg`. All the smartness is in `finaliseBoxity`, which could be moved to DmdAnal completely, if it wasn't for the call to `dubiousDataConInstArgTys` which would be awkward to export. I spent some time figuring out the reason for why `T16197` failed prior to my amendments to `Note [Unboxing evaluated arguments]`. After having it figured out, I minimised it a bit and added `T16197b`, which simply compares computed strictness signatures and thus should be far simpler to eyeball. The 12% ghc/alloc regression in T11545 is because of the additional `Boxity` field in `Poly` and `Prod` that results in more allocation during `lubSubDmd` and `plusSubDmd`. I made sure in the ticky profiles that the number of calls to those functions stayed the same. We can bear such an increase here, as we recently improved it by -68% (in b760c1f). T18698* regress slightly because there is more unboxing of dictionaries happening and that causes Lint (mostly) to allocate more. Fixes #19871, #19407, #4267, #16859, #18907 and #13331. Metric Increase: T11545 T18698a T18698b Metric Decrease: T12425 T16577 T18223 T18282 T4267 T9961 - - - - - 691c450f by Alan Zimmerman at 2021-10-24T01:27:21-04:00 EPA: Use LocatedA for ModuleName This allows us to use an Anchor with a DeltaPos in it when exact printing. - - - - - 3417a81a by Joachim Breitner at 2021-10-24T01:27:57-04:00 undefined: Neater CallStack in error message Users of `undefined` don’t want to see ``` files.hs: Prelude.undefined: CallStack (from HasCallStack): error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err undefined, called at file.hs:151:19 in main:Main ``` but want to see ``` files.hs: Prelude.undefined: CallStack (from HasCallStack): undefined, called at file.hs:151:19 in main:Main ``` so let’s make that so. The function for that is `withFrozenCallStack`, but that is not usable here (module dependencies, and also not representation-polymorphic). And even if it were, it could confuse GHC’s strictness analyzer, leading to big regressions in some perf tests (T10421 in particular). So after shuffling modules and definitions around, I eventually noticed that the easiest way is to just not call `error` here. Fixes #19886 - - - - - 98aa29d3 by John Ericson at 2021-10-24T01:28:33-04:00 Fix dangling reference to RtsConfig.h It hasn't existed since a2a67cd520b9841114d69a87a423dabcb3b4368e -- in 2009! - - - - - 9cde38a0 by John Ericson at 2021-10-25T17:45:15-04:00 Remove stray reference to `dist-ghcconstants` I think this hasn't been a thing since 86054b4ab5125a8b71887b06786d0a428539fb9c, almost 10 years ago! - - - - - 0f7541dc by Viktor Dukhovni at 2021-10-25T17:45:51-04:00 Tweak descriptions of lines and unlines It seems more clear to think of lines as LF-terminated rather than LF-separated. - - - - - 0255ef38 by Zubin Duggal at 2021-10-26T12:36:24-04:00 Warn if unicode bidirectional formatting characters are found in the source (#20263) - - - - - 9cc6c193 by sheaf at 2021-10-26T12:37:02-04:00 Don't default type variables in type families This patch removes the following defaulting of type variables in type and data families: - type variables of kind RuntimeRep defaulting to LiftedRep - type variables of kind Levity defaulting to Lifted - type variables of kind Multiplicity defaulting to Many It does this by passing "defaulting options" to the `defaultTyVars` function; when calling from `tcTyFamInstEqnGuts` or `tcDataFamInstHeader` we pass options that avoid defaulting. This avoids wildcards being defaulted, which caused type families to unexpectedly fail to reduce. Note that kind defaulting, applicable only with -XNoPolyKinds, is not changed by this patch. Fixes #17536 ------------------------- Metric Increase: T12227 ------------------------- - - - - - cc113616 by Artyom Kuznetsov at 2021-10-26T20:27:33+00:00 Change CaseAlt and LambdaExpr to FunRhs in deriving Foldable and Traversable (#20496) - - - - - 9bd6daa4 by John Ericson at 2021-10-27T13:29:39-04:00 Make build system: Generalize and/or document distdirs `manual-package-config` should not hard-code the distdir, and no longer does Elsewhere, we must continue to hard-code due to inconsitent distdir names across stages, so we document this referring to the existing note "inconsistent distdirs". - - - - - 9d577ea1 by John Ericson at 2021-10-27T13:30:15-04:00 Compiler dosen't need to know about certain settings from file - RTS and libdw - SMP - RTS ways I am leaving them in the settings file because `--info` currently prints all the fields in there, but in the future I do believe we should separate the info GHC actually needs from "extra metadata". The latter could go in `+RTS --info` and/or a separate file that ships with the RTS for compile-time inspection instead. - - - - - ed9ec655 by Ben Gamari at 2021-10-27T13:30:55-04:00 base: Note export of Data.Tuple.Solo in changelog - - - - - 638f6548 by Ben Gamari at 2021-10-27T13:30:55-04:00 hadrian: Turn the `static` flavour into a transformer This turns the `static` flavour into the `+fully_static` flavour transformer. - - - - - 522eab3f by Ziyang Liu at 2021-10-29T05:01:50-04:00 Show family TyCons in mk_dict_error in the case of a single match - - - - - 71700526 by Sebastian Graf at 2021-10-29T05:02:25-04:00 Add more INLINABLE and INLINE pragmas to `Enum Int*` instances Otherwise the instances aren't good list producers. See Note [Stable Unfolding for list producers]. - - - - - 925c47b4 by Sebastian Graf at 2021-10-29T05:02:25-04:00 WorkWrap: Update Unfolding with WW'd body prior to `tryWW` (#20510) We have a function in #20510 that is small enough to get a stable unfolding in WW: ```hs small :: Int -> Int small x = go 0 x where go z 0 = z * x go z y = go (z+y) (y-1) ``` But it appears we failed to use the WW'd RHS as the stable unfolding. As a result, inlining `small` would expose the non-WW'd version of `go`. That appears to regress badly in #19727 which is a bit too large to extract a reproducer from that is guaranteed to reproduce across GHC versions. The solution is to simply update the unfolding in `certainlyWillInline` with the WW'd RHS. Fixes #20510. - - - - - 7b67724b by John Ericson at 2021-10-29T16:57:48-04:00 make build system: RTS should use dist-install not dist This is the following find and replace: - `rts/dist` -> `rts/dist-install` # for paths - `rts_dist` -> `rts_dist-install` # for make rules and vars - `,dist` -> `,dist-install` # for make, just in rts/ghc.mk` Why do this? Does it matter when the RTS is just built once? The answer is, yes, I think it does, because I want the distdir--stage correspondence to be consistent. In particular, for #17191 and continuing from d5de970dafd5876ef30601697576167f56b9c132 I am going to make the headers (`rts/includes`) increasingly the responsibility of the RTS (hence their new location). However, those headers are current made for multiple stages. This will probably become unnecessary as work on #17191 progresses and the compiler proper becomes more of a freestanding cabal package (e.g. a library that can be downloaded from Hackage and built without any autoconf). However, until that is finished, we have will transitional period where the RTS and headers need to agree on dirs for multiple stages. I know the make build system is going away, but it's not going yet, so I need to change it to unblock things :). - - - - - b0a1ed55 by Sylvain Henry at 2021-10-29T16:58:35-04:00 Add test for T15547 (#15547) Fix #15547 - - - - - c8d89f62 by Sylvain Henry at 2021-10-29T16:58:35-04:00 Bignum: add missing rule Add missing "Natural -> Integer -> Word#" rule. - - - - - 2a4581ff by sheaf at 2021-10-29T16:59:13-04:00 User's guide: data family kind-inference changes Explain that the kind of a data family instance must now be fully determined by the header of the instance, and how one might migrate code to account for this change. Fixes #20527 - - - - - ea862ef5 by Ben Gamari at 2021-10-30T15:43:28-04:00 ghci: Make getModBreaks robust against DotO Unlinked Previously getModBreaks assumed that an interpreted linkable will have only a single `BCOs` `Unlinked` entry. However, in general an object may also contain `DotO`s; ignore these. Fixes #20570. - - - - - e4095c0c by John Ericson at 2021-10-31T09:04:41-04:00 Make build system: Put make generated include's in RTS distdirs These are best thought of as being part of the RTS. - After !6791, `ghcautoconf.h` won't be used by the compiler inappropriately. - `ghcversion.h` is only used once outside the RTS, which is `compiler/cbits/genSym.c`. Except we *do* mean the RTS GHC is built against there, so it's better if we always get get the installed version. - `ghcplatform.h` alone is used extensively outside the RTS, but since we no longer have a target platform it is perfectly safe/correct to get the info from the previous RTS. All 3 are exported from the RTS currently and in the bootstrap window. This commit just swaps directories around, such that the new headers may continue to be used in stage 0 despite the reasoning above, but the idea is that we can subsequently make more interesting changes doubling down on the reasoning above. In particular, in !6803 we'll start "morally" moving `ghcautonconf.h` over, introducing an RTS configure script and temporary header of its `AC_DEFINE`s until the top-level configure script doesn't define any more. Progress towards #17191 - - - - - f5471c0b by John Ericson at 2021-10-31T09:05:16-04:00 Modularize autoconf platform detection This will allow better reuse of it, such as in the upcoming RTS configure script. Progress towards #17191 - - - - - 6b38c8a6 by Ben Gamari at 2021-10-31T09:05:52-04:00 ghc: Bump Cabal-Version to 1.22 This is necessary to use reexported-modules - - - - - 6544446d by Ben Gamari at 2021-10-31T09:05:52-04:00 configure: Hide error output from --target check - - - - - 7445bd71 by Andreas Klebinger at 2021-11-01T12:13:45+00:00 Update comment in Lint.hs mkWwArgs has been renamed to mkWorkerArgs. - - - - - f1a782dd by Vladislav Zavialov at 2021-11-02T01:36:32-04:00 HsToken for let/in (#19623) One more step towards the new design of EPA. - - - - - 37a37139 by John Ericson at 2021-11-02T01:37:08-04:00 Separate some AC_SUBST / AC_DEFINE Eventually, the RTS configure alone will need the vast majority of AC_DEFINE, and the top-level configure will need the most AC_SUBST. By removing the "side effects" of the macros like this we make them more reusable so they can be shared between the two configures without doing too much. - - - - - 2f69d102 by John Ericson at 2021-11-02T01:37:43-04:00 Remove `includes_GHCCONSTANTS` from make build system It is dead code. - - - - - da1a8e29 by John Ericson at 2021-11-02T01:37:43-04:00 Treat generated RTS headers in a more consistent manner We can depend on all of them at once the same way. - - - - - a7e1be3d by Ryan Scott at 2021-11-02T01:38:53-04:00 Fix #20590 with another application of mkHsContextMaybe We were always converting empty GADT contexts to `Just []` in `GHC.ThToHs`, which caused the pretty-printer to always print them as `() => ...`. This is easily fixed by using the `mkHsContextMaybe` function when converting GADT contexts so that empty contexts are turned to `Nothing`. This is in the same tradition established in commit 4c87a3d1d14f9e28c8aa0f6062e9c4201f469ad7. In the process of fixing this, I discovered that the `Cxt` argument to `mkHsContextMaybe` is completely unnecessary, as we can just as well check if the `LHsContext GhcPs` argument is empty. Fixes #20590. - - - - - 39eed84c by Alan Zimmerman at 2021-11-02T21:39:32+00:00 EPA: Get rid of bare SrcSpan's in the ParsedSource The ghc-exactPrint library has had to re-introduce the relatavise phase. This is needed if you change the length of an identifier and want the layout to be preserved afterwards. It is not possible to relatavise a bare SrcSpan, so introduce `SrcAnn NoEpAnns` for them instead. Updates haddock submodule. - - - - - 9f42a6dc by ARATA Mizuki at 2021-11-03T09:19:17-04:00 hadrian: Use $bindir instead of `dirname $0` in ghci wrapper `dirname $0` doesn't work when the wrapper is called via a symbolic link. Fix #20589 - - - - - bf6f96a6 by Vladislav Zavialov at 2021-11-03T16:35:50+03:00 Generalize the type of wrapLocSndMA - - - - - 1419fb16 by Matthew Pickering at 2021-11-04T00:36:09-04:00 ci: Don't run alpine job in fast-ci - - - - - 6020905a by Takenobu Tani at 2021-11-04T09:40:42+00:00 Correct load_load_barrier for risc-v This patch corrects the instruction for load_load_barrier(). Current load_load_barrier() incorrectly uses `fence w,r`. It means a store-load barrier. See also linux-kernel's smp_rmb() implementation: https://github.com/torvalds/linux/blob/v5.14/arch/riscv/include/asm/barrier.h#L27 - - - - - 086e288c by Richard Eisenberg at 2021-11-04T13:04:44-04:00 Tiny renamings and doc updates Close #20433 - - - - - f0b920d1 by CarrieMY at 2021-11-05T05:30:13-04:00 Fix deferOutOfScopeVariables for qualified #20472 - - - - - 59dfb005 by Simon Peyton Jones at 2021-11-05T05:30:48-04:00 Remove record field from Solo Ticket #20562 revealed that Solo, which is a wired-in TyCon, had a record field that wasn't being added to the type env. Why not? Because wired-in TyCons don't have record fields. It's not hard to change that, but it's tiresome for this one use-case, and it seems easier simply to make `getSolo` into a standalone function. On the way I refactored the handling of Solo slightly, to put it into wiredInTyCons (where it belongs) rather than only in knownKeyNames - - - - - be3750a5 by Matthew Pickering at 2021-11-05T10:12:16-04:00 Allow CApi FFI calls in GHCi At some point in the past this started working. I noticed this when working on multiple home units and couldn't load GHC's dependencies into the interpreter. Fixes #7388 - - - - - d96ce59d by John Ericson at 2021-11-05T10:12:52-04:00 make: Futher systematize handling of generated headers This will make it easier to add and remove generated headers, as we will do when we add a configure script for the RTS. - - - - - 3645abac by John Ericson at 2021-11-05T20:25:32-04:00 Avoid GHC_STAGE and other include bits We should strive to make our includes in terms of the RTS as much as possible. One place there that is not possible, the llvm version, we make a new tiny header Stage numbers are somewhat arbitrary, if we simple need a newer RTS, we should say so. - - - - - 4896a6a6 by Matthew Pickering at 2021-11-05T20:26:07-04:00 Fix boolean confusion with Opt_NoLlvmMangler flag I accidently got the two branches of the if expression the wrong way around when refactoring. Fixes #20567 - - - - - d74cc01e by Ziyang Liu at 2021-11-06T07:53:06-04:00 Export `withTcPlugins` and `withHoleFitPlugins` - - - - - ecd6d142 by Sylvain Henry at 2021-11-06T07:53:42-04:00 i386: fix codegen of 64-bit comparisons - - - - - e279ea64 by Sylvain Henry at 2021-11-06T07:53:42-04:00 Add missing Int64/Word64 constant-folding rules - - - - - 4c86df25 by Sylvain Henry at 2021-11-06T07:53:42-04:00 Fix Int64ToInt/Word64ToWord rules on 32-bit architectures When the input literal was larger than 32-bit it would crash in a compiler with assertion enabled because it was creating an out-of-bound word-sized literal (32-bit). - - - - - 646c3e21 by Sylvain Henry at 2021-11-06T07:53:42-04:00 CI: allow perf-nofib to fail - - - - - 20956e57 by Sylvain Henry at 2021-11-06T07:53:42-04:00 Remove target dependent CPP for Word64/Int64 (#11470) Primops types were dependent on the target word-size at *compiler* compilation time. It's an issue for multi-target as GHC may not have the correct primops types for the target. This patch fixes some primops types: if they take or return fixed 64-bit values they now always use `Int64#/Word64#`, even on 64-bit architectures (where they used `Int#/Word#` before). Users of these primops may now need to convert from Int64#/Word64# to Int#/Word# (a no-op at runtime). This is a stripped down version of !3658 which goes the all way of changing the underlying primitive types of Word64/Int64. This is left for future work. T12545 allocations increase ~4% on some CI platforms and decrease ~3% on AArch64. Metric Increase: T12545 Metric Decrease: T12545 - - - - - 2800eee2 by Sylvain Henry at 2021-11-06T07:53:42-04:00 Make Word64 use Word64# on every architecture - - - - - be9d7862 by Sylvain Henry at 2021-11-06T07:53:42-04:00 Fix Int64/Word64's Enum instance fusion Performance improvement: T15185(normal) run/alloc 51112.0 41032.0 -19.7% GOOD Metric Decrease: T15185 - - - - - 6f2d6a5d by Nikolay Yakimov at 2021-11-06T11:24:50-04:00 Add regression test for #20568 GHC produced broken executables with rebindable if and -fhpc if `ifThenElse` expected non-Bool condition until GHC 9.0. This adds a simple regression test. - - - - - 7045b783 by Vladislav Zavialov at 2021-11-06T11:25:25-04:00 Refactor HdkM using deriving via * No more need for InlineHdkM, mkHdkM * unHdkM is now just a record selector * Update comments - - - - - 0d8a883e by Andreas Klebinger at 2021-11-07T12:54:30-05:00 Don't undersaturate join points through eta-reduction. In #20599 I ran into an issue where the unfolding for a join point was eta-reduced removing the required lambdas. This patch adds guards that should prevent this from happening going forward. - - - - - 3d7e3d91 by Vladislav Zavialov at 2021-11-07T12:55:05-05:00 Print the Type kind qualified when ambiguous (#20627) The Type kind is printed unqualified: ghci> :set -XNoStarIsType ghci> :k (->) (->) :: Type -> Type -> Type This is the desired behavior unless the user has defined their own Type: ghci> data Type Then we want to resolve the ambiguity by qualification: ghci> :k (->) (->) :: GHC.Types.Type -> GHC.Types.Type -> GHC.Types.Type - - - - - 184f6bc6 by John Ericson at 2021-11-07T16:26:10-05:00 Factor out unregisterised and tables next to code m4 macros These will be useful for upcoming RTS configure script. - - - - - 56705da8 by Sebastian Graf at 2021-11-07T16:26:46-05:00 Pmc: Do inhabitation test for unlifted vars (#20631) Although I thought we were already set to handle unlifted datatypes correctly, it appears we weren't. #20631 showed that it's wrong to assume `vi_bot=IsNotBot` for `VarInfo`s of unlifted types from their inception if we don't follow up with an inhabitation test to see if there are any habitable constructors left. We can't trigger the test from `emptyVarInfo`, so now we instead fail early in `addBotCt` for variables of unlifted types. Fixed #20631. - - - - - 28334b47 by sheaf at 2021-11-08T13:40:05+01:00 Default kind vars in tyfams with -XNoPolyKinds We should still default kind variables in type families in the presence of -XNoPolyKinds, to avoid suggesting enabling -XPolyKinds just because the function arrow introduced kind variables, e.g. type family F (t :: Type) :: Type where F (a -> b) = b With -XNoPolyKinds, we should still default `r :: RuntimeRep` in `a :: TYPE r`. Fixes #20584 - - - - - 3f103b1a by John Ericson at 2021-11-08T19:35:12-05:00 Factor out GHC_ADJUSTORS_METHOD m4 macro - - - - - ba9fdc51 by John Ericson at 2021-11-08T19:35:12-05:00 Factor out FP_FIND_LIBFFI and use in RTS configure too - - - - - 2929850f by Sylvain Henry at 2021-11-09T10:02:06-05:00 RTS: open timerfd synchronously (#20618) - - - - - bc498fdf by Sylvain Henry at 2021-11-09T10:02:46-05:00 Bignum: expose backendName (#20495) - - - - - 79a26df1 by Sylvain Henry at 2021-11-09T10:02:46-05:00 Don't expose bignum backend in ghc --info (#20495) GHC is bignum backend agnostic and shouldn't report this information as in the future ghc-bignum will be reinstallable potentially with a different backend that GHC is unaware of. Moreover as #20495 shows the returned information may be wrong currently. - - - - - e485f4f2 by Andreas Klebinger at 2021-11-09T19:54:31-05:00 SpecConstr - Attach evaldUnfolding to known evaluated arguments. - - - - - 983a99f0 by Ryan Scott at 2021-11-09T19:55:07-05:00 deriving: infer DatatypeContexts from data constructors, not type constructor Previously, derived instances that use `deriving` clauses would infer `DatatypeContexts` by using `tyConStupidTheta`. But this sometimes causes redundant constraints to be included in the derived instance contexts, as the constraints that appear in the `tyConStupidTheta` may not actually appear in the types of the data constructors (i.e., the `dataConStupidTheta`s). For instance, in `data Show a => T a = MkT deriving Eq`, the type of `MkT` does not require `Show`, so the derived `Eq` instance should not require `Show` either. This patch makes it so with some small tweaks to `inferConstraintsStock`. Fixes #20501. - - - - - bdd7b2be by Ryan Scott at 2021-11-09T19:55:07-05:00 Flesh out Note [The stupid context] and reference it `Note [The stupid context]` in `GHC.Core.DataCon` talks about stupid contexts from `DatatypeContexts`, but prior to this commit, it was rather outdated. This commit spruces it up and references it from places where it is relevant. - - - - - 95563259 by Li-yao Xia at 2021-11-10T09:16:21-05:00 Fix rendering of Applicative law - - - - - 0f852244 by Viktor Dukhovni at 2021-11-10T09:16:58-05:00 Improve ZipList section of Traversable overview - Fix cut/paste error by adding missing `c` pattern in `Vec3` traversable instance. - Add a bit of contextual prose above the Vec2/Vec3 instance sample code. - - - - - c4cd13b8 by Richard Eisenberg at 2021-11-10T18:18:19-05:00 Fix Note [Function types] Close #19938. - - - - - dfb9913c by sheaf at 2021-11-10T18:18:59-05:00 Improvements to rank_polymorphism.rst - rename the function f4 to h1 for consistency with the naming convention - be more explicit about the difference between `Int -> (forall a. a -> a)` and `forall a. Int -> (a -> a)` - reorder the section to make it flow better Fixes #20585 - - - - - 1540f556 by sheaf at 2021-11-10T18:19:37-05:00 Clarify hs-boot file default method restrictions The user guide wrongly stated that default methods should not be included in hs-boot files. In fact, if the class is not left abstract (no methods, no superclass constraints, ...) then the defaults must be provided and match with those given in the .hs file. We add some tests for this, as there were no tests in the testsuite that gave rise to the "missing default methods" error. Fixes #20588 - - - - - 8c0aec38 by Sylvain Henry at 2021-11-10T18:20:17-05:00 Hadrian: fix building/registering of .dll libraries - - - - - 11c9a469 by Matthew Pickering at 2021-11-11T07:21:28-05:00 testsuite: Convert hole fit performance tests into proper perf tests Fixes #20621 - - - - - c2ed85cb by Matthew Pickering at 2021-11-11T07:22:03-05:00 driver: Cache the transitive dependency calculation in ModuleGraph Two reasons for this change: 1. Avoid computing the transitive dependencies when compiling each module, this can save a lot of repeated work. 2. More robust to forthcoming changes to support multiple home units. - - - - - 4230e4fb by Matthew Pickering at 2021-11-11T07:22:03-05:00 driver: Use shared transitive dependency calculation in hptModulesBelow This saves a lot of repeated work on big dependency graphs. ------------------------- Metric Decrease: MultiLayerModules T13719 ------------------------- - - - - - af653b5f by Matthew Bauer at 2021-11-11T07:22:39-05:00 Only pass -pie, -no-pie when linking Previously, these flags were passed when both compiling and linking code. However, `-pie` and `-no-pie` are link-time-only options. Usually, this does not cause issues, but when using Clang with `-Werror` set results in errors: clang: error: argument unused during compilation: '-nopie' [-Werror,-Wunused-command-line-argument] This is unused by Clang because this flag has no effect at compile time (it’s called `-nopie` internally by Clang but called `-no-pie` in GHC for compatibility with GCC). Just passing these flags at linking time resolves this. Additionally, update #15319 hack to look for `-pgml` instead. Because of the main change, the value of `-pgmc` does not matter when checking for the workaround of #15319. However, `-pgml` *does* still matter as not all `-pgml` values support `-no-pie`. To cover all potential values, we assume that no custom `-pgml` values support `-no-pie`. This means that we run the risk of not using `-no-pie` when it is otherwise necessary for in auto-hardened toolchains! This could be a problem at some point, but this workaround was already introduced in 8d008b71 and we might as well continue supporting it. Likewise, mark `-pgmc-supports-no-pie` as deprecated and create a new `-pgml-supports-no-pie`. - - - - - 7cc6ebdf by Sebastian Graf at 2021-11-11T07:23:14-05:00 Add regression test for #20598 Fixes #20598, which is mostly a duplicate of #18824 but for GHC 9.2. - - - - - 7b44c816 by Simon Jakobi at 2021-11-12T21:20:17-05:00 Turn GHC.Data.Graph.Base.Graph into a newtype - - - - - a57cc754 by John Ericson at 2021-11-12T21:20:52-05:00 Make: Do not generate ghc.* headers in stage0 GHC should get everything it needs from the RTS, which for stage0 is the "old" RTS that comes from the bootstrap compiler. - - - - - 265ead8a by Richard Eisenberg at 2021-11-12T21:21:27-05:00 Improve redundant-constraints warning Previously, we reported things wrong with f :: (Eq a, Ord a) => a -> Bool f x = x == x saying that Eq a was redundant. This is fixed now, along with some simplification in Note [Replacement vs keeping]. There's a tiny bit of extra complexity in setImplicationStatus, but it's explained in Note [Tracking redundant constraints]. Close #20602 - - - - - ca90ffa3 by Richard Eisenberg at 2021-11-12T21:21:27-05:00 Use local instances with least superclass depth See new Note [Use only the best local instance] in GHC.Tc.Solver.Interact. This commit also refactors the InstSC/OtherSC mechanism slightly. Close #20582. - - - - - dfc4093c by Vladislav Zavialov at 2021-11-12T21:22:03-05:00 Implement -Wforall-identifier (#20609) In accordance with GHC Proposal #281 "Visible forall in types of terms": For three releases before this change takes place, include a new warning -Wforall-identifier in -Wdefault. This warning will be triggered at definition sites (but not use sites) of forall as an identifier. Updates the haddock submodule. - - - - - 4143bd21 by Cheng Shao at 2021-11-12T21:22:39-05:00 hadrian: use /bin/sh in timeout wrapper /usr/bin/env doesn't work within a nix build. - - - - - 43cab5f7 by Simon Peyton Jones at 2021-11-12T21:23:15-05:00 Get the in-scope set right in simplArg This was a simple (but long standing) error in simplArg, revealed by #20639 - - - - - 578b8b48 by Ben Gamari at 2021-11-12T21:23:51-05:00 gitlab-ci: Allow draft MRs to fail linting jobs Addresses #20623 by allowing draft MRs to fail linting jobs. - - - - - 908e49fa by Ben Gamari at 2021-11-12T21:23:51-05:00 Fix it - - - - - 05166660 by Ben Gamari at 2021-11-12T21:23:51-05:00 Fix it - - - - - e41cffb0 by Ben Gamari at 2021-11-12T21:23:51-05:00 Fix it - - - - - cce3a025 by Ben Gamari at 2021-11-12T21:23:51-05:00 Fix it - - - - - 4499db7d by Ben Gamari at 2021-11-12T21:23:51-05:00 Fix it - - - - - dd1be88b by Travis Whitaker at 2021-11-12T21:24:29-05:00 mmapForLinkerMarkExecutable: do nothing when len = 0 - - - - - 4c6ace75 by John Ericson at 2021-11-12T21:25:04-05:00 Delete compiler/MachDeps.h This was accidentally added back in 28334b475a109bdeb8d53d58c48adb1690e2c9b4 after it is was no longer needed by the compiler proper in 20956e5784fe43781d156dd7ab02f0bff4ab41fb. - - - - - 490e8c75 by John Ericson at 2021-11-12T21:25:40-05:00 Generate ghcversion.h with the top-level configure This is, rather unintuitively, part of the goal of making the packages that make of the GHC distribution more freestanding. `ghcversion.h` is very simple, so we easily can move it out of the main build systems (make and Hadrian). By doing so, the RTS becomes less of a special case to those build systems as the header, already existing in the source tree, appears like any other. We could do this with the upcomming RTS configure, but it hardly matters because there is nothing platform-specific here, it is just versioning information like the other files the top-level configure can be responsible for. - - - - - bba156f3 by John Ericson at 2021-11-12T21:26:15-05:00 Remove bit about size_t in ghc-llvm-version.h This shouldn't be here. It wasn't causing a problem because this header was only used from Haskell, but still. - - - - - 0b1da2f1 by John Ericson at 2021-11-12T21:26:50-05:00 Make: Install RTS headers in `$libdir/rts/include` not `$libdir/include` Before we were violating the convention of every other package. This fixes that. It matches the changes made in d5de970dafd5876ef30601697576167f56b9c132 to the location of the files in the repo. - - - - - b040d0d4 by Sebastian Graf at 2021-11-12T21:27:26-05:00 Add regression test for #20663 - - - - - c6065292 by John Ericson at 2021-11-12T21:28:02-05:00 Make: Move remaining built RTS headers to ...build/include This allows us to clean up the rts include dirs in the package conf. - - - - - aa372972 by Ryan Scott at 2021-11-15T10:17:57-05:00 Refactoring: Consolidate some arguments with DerivInstTys Various functions in GHC.Tc.Deriv.* were passing around `TyCon`s and `[Type]`s that ultimately come from the same `DerivInstTys`. This patch moves the definition of `DerivInstTys` to `GHC.Tc.Deriv.Generate` so that all of these `TyCon` and `[Type]` arguments can be consolidated into a single `DerivInstTys`. Not only does this make the code easier to read (in my opinion), this will also be important in a subsequent commit where we need to add another field to `DerivInstTys` that will also be used from `GHC.Tc.Deriv.Generate` and friends. - - - - - 564a19af by Ryan Scott at 2021-11-15T10:17:57-05:00 Refactoring: Move DataConEnv to GHC.Core.DataCon `DataConEnv` will prove to be useful in another place besides `GHC.Core.Opt.SpecConstr` in a follow-up commit. - - - - - 3e5f0595 by Ryan Scott at 2021-11-15T10:17:57-05:00 Instantiate field types properly in stock-derived instances Previously, the `deriving` machinery was very loosey-goosey about how it used the types of data constructor fields when generating code. It would usually just consult `dataConOrigArgTys`, which returns the _uninstantiated_ field types of each data constructor. Usually, you can get away with this, but issues #20375 and #20387 revealed circumstances where this approach fails. Instead, when generated code for a stock-derived instance `C (T arg_1 ... arg_n)`, one must take care to instantiate the field types of each data constructor with `arg_1 ... arg_n`. The particulars of how this is accomplished is described in the new `Note [Instantiating field types in stock deriving]` in `GHC.Tc.Deriv.Generate`. Some highlights: * `DerivInstTys` now has a new `dit_dc_inst_arg_env :: DataConEnv [Type]` field that caches the instantiated field types of each data constructor. Whenever we need to consult the field types somewhere in `GHC.Tc.Deriv.*` we avoid using `dataConOrigArgTys` and instead look it up in `dit_dc_inst_arg_env`. * Because `DerivInstTys` now stores the instantiated field types of each constructor, some of the details of the `GHC.Tc.Deriv.Generics.mkBindsRep` function were able to be simplified. In particular, we no longer need to apply a substitution to instantiate the field types in a `Rep(1)` instance, as that is already done for us by `DerivInstTys`. We still need a substitution to implement the "wrinkle" section of `Note [Generating a correctly typed Rep instance]`, but the code is nevertheless much simpler than before. * The `tyConInstArgTys` function has been removed in favor of the new `GHC.Core.DataCon.dataConInstUnivs` function, which is really the proper tool for the job. `dataConInstUnivs` is much like `tyConInstArgTys` except that it takes a data constructor, not a type constructor, as an argument, and it adds extra universal type variables from that data constructor at the end of the returned list if need be. `dataConInstUnivs` takes care to instantiate the kinds of the universal type variables at the end, thereby avoiding a bug in `tyConInstArgTys` discovered in https://gitlab.haskell.org/ghc/ghc/-/issues/20387#note_377037. Fixes #20375. Fixes #20387. - - - - - 25d36c31 by John Ericson at 2021-11-15T10:18:32-05:00 Make: Get rid of GHC_INCLUDE_DIRS These dirs should not be included in all stages. Instead make the per-stage `BUILD_*_INCLUDE_DIR` "plural" to insert `rts/include` in the right place. - - - - - b679721a by John Ericson at 2021-11-15T10:18:32-05:00 Delete dead code knobs for building GHC itself As GHC has become target agnostic, we've left behind some now-useless logic in both build systems. - - - - - 3302f42a by Sylvain Henry at 2021-11-15T13:19:42-05:00 Fix windres invocation I've already fixed this 7 months ago in the comments of #16780 but it never got merged. Now we need this for #20657 too. - - - - - d9f54905 by Sylvain Henry at 2021-11-15T13:19:42-05:00 Hadrian: fix windows cross-build (#20657) Many small things to fix: * Hadrian: platform triple is "x86_64-w64-mingw32" and this wasn't recognized by Hadrian (note "w64" instead of "unknown") * Hadrian was using the build platform ("isWindowsHost") to detect the use of the Windows toolchain, which was wrong. We now use the "targetOs" setting. * Hadrian was doing the same thing for Darwin so we fixed both at once, even if cross-compilation to Darwin is unlikely to happen afaik (cf "osxHost" vs "osxTarget" changes) * Hadrian: libffi name was computed in two different places and one of them wasn't taking the different naming on Windows into account. * Hadrian was passing "-Irts/include" when building the stage1 compiler leading to the same error as in #18143 (which is using make). stage1's RTS is stage0's one so mustn't do this. * Hadrian: Windows linker doesn't seem to support "-zorigin" so we don't pass it (similarly to Darwin) * Hadrian: hsc2hs in cross-compilation mode uses a trick (taken from autoconf): it defines "static int test_array[SOME_EXPR]" where SOME_EXPR is a constant expression. However GCC reports an error because SOME_EXPR is supposedly not constant. This is fixed by using another method enabled with the `--via-asm` flag of hsc2hs. It has been fixed in `make` build system (5f6fcf7808b16d066ad0fb2068225b3f2e8363f7) but not in Hadrian. * Hadrian: some packages are specifically built only on Windows but they shouldn't be when building a cross-compiler (`touchy` and `ghci-wrapper`). We now correctly detect this case and disable these packages. * Base: we use `iNVALID_HANDLE_VALUE` in a few places. It fixed some hsc2hs issues before we switched to `--via-asm` (see above). I've kept these changes are they make the code nicer. * Base: `base`'s configure tries to detect if it is building for Windows but for some reason the `$host_alias` value is `x86_64-windows` in my case and it wasn't properly detected. * Base: libraries/base/include/winio_structs.h imported "Windows.h" with a leading uppercase. It doesn't work on case-sensitive systems when cross-compiling so we have to use "windows.h". * RTS: rts/win32/ThrIOManager.c was importin "rts\OSThreads.h" but this path isn't valid when cross-compiling. We replaced "\" with "/". * DeriveConstants: this tool derives the constants from the target RTS header files. However these header files define `StgAsyncIOResult` only when `mingw32_HOST_OS` is set hence it seems we have to set it explicitly. Note that deriveConstants is called more than once (why? there is only one target for now so it shouldn't) and in the second case this value is correctly defined (probably coming indirectly from the import of "rts/PosixSource.h"). A better fix would probably be to disable the unneeded first run of deriveconstants. - - - - - cc635da1 by Richard Eisenberg at 2021-11-15T13:20:18-05:00 Link to ghc-proposals repo from README A potential contributor said that they weren't aware of ghc-proposals. This might increase visibility. - - - - - a8e1a756 by Ben Gamari at 2021-11-16T03:12:34-05:00 gitlab-ci: Refactor toolchain provision This makes it easier to invoke ci.sh on Darwin by teaching it to manage the nix business. - - - - - 1f0014a8 by Ben Gamari at 2021-11-16T03:12:34-05:00 gitlab-ci: Fail if dynamic references are found in a static bindist Previously we called error, which just prints an error, rather than fail, which actually fails. - - - - - 85f2c0ba by Ben Gamari at 2021-11-16T03:12:34-05:00 gitlab-ci/darwin: Move SDK path discovery into toolchain.nix Reduce a bit of duplication and a manual step when running builds manually. - - - - - 3e94b5a7 by John Ericson at 2021-11-16T03:13:10-05:00 Make: Get rid of `BUILD_.*_INCLUDE_DIRS` First, we improve some of the rules around -I include dirs, and CPP opts. Then, we just specify the RTS's include dirs normally (locally per the package and in the package conf), and then everything should work normally. The primops.txt.pp rule needs no extra include dirs at all, as it no longer bakes in a target platfom. Reverts some of the extra stage arguments I added in 05419e55cab272ed39790695f448b311f22669f7, as they are no longer needed. - - - - - 083a7583 by Ben Gamari at 2021-11-17T05:10:27-05:00 Increase type sharing Fixes #20541 by making mkTyConApp do more sharing of types. In particular, replace * BoxedRep Lifted ==> LiftedRep * BoxedRep Unlifted ==> UnliftedRep * TupleRep '[] ==> ZeroBitRep * TYPE ZeroBitRep ==> ZeroBitType In each case, the thing on the right is a type synonym for the thing on the left, declared in ghc-prim:GHC.Types. See Note [Using synonyms to compress types] in GHC.Core.Type. The synonyms for ZeroBitRep and ZeroBitType are new, but absolutely in the same spirit as the other ones. (These synonyms are mainly for internal use, though the programmer can use them too.) I also renamed GHC.Core.Ty.Rep.isVoidTy to isZeroBitTy, to be compatible with the "zero-bit" nomenclature above. See discussion on !6806. There is a tricky wrinkle: see GHC.Core.Types Note [Care using synonyms to compress types] Compiler allocation decreases by up to 0.8%. - - - - - 20a4f251 by Ben Gamari at 2021-11-17T05:11:03-05:00 hadrian: Factor out --extra-*-dirs=... pattern We repeated this idiom quite a few times. Give it a name. - - - - - 4cec6cf2 by Ben Gamari at 2021-11-17T05:11:03-05:00 hadrian: Ensure that term.h is in include search path terminfo now requires term.h but previously neither build system offered any way to add the containing directory to the include search path. Fix this in Hadrian. Also adds libnuma includes to global include search path as it was inexplicably missing earlier. - - - - - 29086749 by Sebastian Graf at 2021-11-17T05:11:38-05:00 Pmc: Don't case split on wildcard matches (#20642) Since 8.10, when formatting a pattern match warning, we'd case split on a wildcard match such as ```hs foo :: [a] -> [a] foo [] = [] foo xs = ys where (_, ys@(_:_)) = splitAt 0 xs -- Pattern match(es) are non-exhaustive -- In a pattern binding: -- Patterns not matched: -- ([], []) -- ((_:_), []) ``` But that's quite verbose and distracts from which part of the pattern was actually the inexhaustive one. We'd prefer a wildcard for the first pair component here, like it used to be in GHC 8.8. On the other hand, case splitting is pretty handy for `-XEmptyCase` to know the different constructors we could've matched on: ```hs f :: Bool -> () f x = case x of {} -- Pattern match(es) are non-exhaustive -- In a pattern binding: -- Patterns not matched: -- False -- True ``` The solution is to communicate that we want a top-level case split to `generateInhabitingPatterns` for `-XEmptyCase`, which is exactly what this patch arranges. Details in `Note [Case split inhabiting patterns]`. Fixes #20642. - - - - - c591ab1f by Sebastian Graf at 2021-11-17T05:11:38-05:00 testsuite: Refactor pmcheck all.T - - - - - 33c0c83d by Andrew Pritchard at 2021-11-17T05:12:17-05:00 Fix Haddock markup on Data.Type.Ord.OrdCond. - - - - - 7bcd91f4 by Andrew Pritchard at 2021-11-17T05:12:17-05:00 Provide in-line kind signatures for Data.Type.Ord.Compare. Haddock doesn't know how to render SAKS, so the only current way to make the documentation show the kind is to write what it should say into the type family declaration. - - - - - 16d86b97 by ARATA Mizuki at 2021-11-17T05:12:56-05:00 bitReverse functions in GHC.Word are since base-4.14.0.0, not 4.12.0.0 They were added in 33173a51c77d9960d5009576ad9b67b646dfda3c, which constitutes GHC 8.10.1 / base-4.14.0.0 - - - - - 7850142c by Morrow at 2021-11-17T11:14:37+00:00 Improve handling of import statements in GHCi (#20473) Currently in GHCi, when given a line of user input we: 1. Attempt to parse and handle it as a statement 2. Otherwise, attempt to parse and handle a single import 3. Otherwise, check if there are imports present (and if so display an error message) 4. Otherwise, attempt to parse a module and only handle the declarations This patch simplifies the process to: Attempt to parse and handle it as a statement Otherwise, attempt to parse a module and handle the imports and declarations This means that multiple imports in a multiline are now accepted, and a multiline containing both imports and declarations is now accepted (as well as when separated by semicolons). - - - - - 09d44b4c by Zubin Duggal at 2021-11-18T01:37:36-05:00 hadrian: add threadedDebug RTS way to devel compilers - - - - - 5fa45db7 by Zubin Duggal at 2021-11-18T01:37:36-05:00 testsuite: disable some tests when we don't have dynamic libraries - - - - - f8c1c549 by Matthew Pickering at 2021-11-18T01:38:11-05:00 Revert "base: Use one-shot kqueue on macOS" This reverts commit 41117d71bb58e001f6a2b6a11c9314d5b70b9182 - - - - - f55ae180 by Simon Peyton Jones at 2021-11-18T14:44:45-05:00 Add one line of comments (c.f. !5706) Ticket #19815 suggested changing coToMCo to use isReflexiveCo rather than isReflCo. But perf results weren't encouraging. This patch just adds a comment to point to the data, such as it is. - - - - - 12d023d1 by Vladislav Zavialov at 2021-11-18T14:45:20-05:00 testsuite: check for FlexibleContexts in T17563 The purpose of testsuite/tests/typecheck/should_fail/T17563.hs is to make sure we do validity checking on quantified constraints. In particular, see the following functions in GHC.Tc.Validity: * check_quant_pred * check_pred_help * check_class_pred The original bug report used a~b constraints as an example of a constraint that requires validity checking. But with GHC Proposal #371, equality constraints no longer require GADTs or TypeFamilies; instead, they require TypeOperators, which are checked earlier in the pipeline, in the renamer. Rather than simply remove this test, we change the example to use another extension: FlexibleContexts. Since we decide whether a constraint requires this extension in check_class_pred, the regression test continues to exercise the relevant code path. - - - - - 78d4bca0 by Ben Gamari at 2021-11-18T22:27:20-05:00 ghc-cabal, make: Add support for building C++ object code Co-Authored By: Matthew Pickering <matthew at well-typed.com> - - - - - a8b4961b by Ben Gamari at 2021-11-18T22:27:20-05:00 Bump Cabal submodule - - - - - 59e8a900 by Ben Gamari at 2021-11-18T22:27:20-05:00 Bump text and parsec submodules Accommodates text-2.0. Metric Decrease: T15578 - - - - - 7f7d7888 by Ben Gamari at 2021-11-18T22:27:20-05:00 ghc-cabal: Use bootstrap compiler's text package This avoids the need to build `text` without Cabal, in turn avoiding the need to reproduce the workaround for #20010 contained therein. - - - - - 048f8d96 by Ben Gamari at 2021-11-18T22:27:20-05:00 gitlab-ci: Bump MACOSX_DEPLOYMENT_TARGET It appears that Darwin's toolchain includes system headers in the dependency makefiles it generates with `-M` with older `MACOSX_DEPLOYMENT_TARGETS`. To avoid this we have bumped the deployment target for x86-64/Darwin to 10.10. - - - - - 0acbbd20 by Ben Gamari at 2021-11-18T22:27:20-05:00 testsuite: Use libc++ rather than libstdc++ in objcpp-hi It appears that libstdc++ is no longer available in recent XCode distributions. Closes #16083. - - - - - aed98dda by John Ericson at 2021-11-18T22:27:55-05:00 Hadrian: bring up to date with latest make improvements Headers should be associated with the RTS, and subject to less hacks. The most subtle issue was that the package-grained dependencies on generated files were being `need`ed before calculating Haskell deps, but not before calculating C/C++ deps. - - - - - aabff109 by Ben Gamari at 2021-11-20T05:34:27-05:00 Bump deepseq submodule to 1.4.7.0-pre Addresses #20653. - - - - - 3d6b78db by Matthew Pickering at 2021-11-20T05:35:02-05:00 Remove unused module import syntax from .bkp mode .bkp mode had this unused feature where you could write module A and it would go looking for A.hs on the file system and use that rather than provide the definition inline. This isn't use anywhere in the testsuite and the code to find the module A looks dubious. Therefore to reduce .bkp complexity I propose to remove it. Fixes #20701 - - - - - bdeea37e by Sylvain Henry at 2021-11-20T05:35:42-05:00 More support for optional home-unit This is a preliminary refactoring for #14335 (supporting plugins in cross-compilers). In many places the home-unit must be optional because there won't be one available in the plugin environment (we won't be compiling anything in this environment). Hence we replace "HomeUnit" with "Maybe HomeUnit" in a few places and we avoid the use of "hsc_home_unit" (which is partial) in some few others. - - - - - 29e03071 by Ben Gamari at 2021-11-20T05:36:18-05:00 rts: Ensure that markCAFs marks object code Previously `markCAFs` would only evacuate CAFs' indirectees. This would allow reachable object code to be unloaded by the linker as `evacuate` may never be called on the CAF itself, despite it being reachable via the `{dyn,revertible}_caf_list`s. To fix this we teach `markCAFs` to explicit call `markObjectCode`, ensuring that the linker is aware of objects reachable via the CAF lists. Fixes #20649. - - - - - b2933ea9 by Ben Gamari at 2021-11-20T05:36:54-05:00 gitlab-ci: Set HOME to plausible but still non-existent location We have been seeing numerous CI failures on aarch64/Darwin of the form: CI_COMMIT_BRANCH: CI_PROJECT_PATH: ghc/ghc error: creating directory '/nonexistent': Read-only file system Clearly *something* is attempting to create `$HOME`. A bit of sleuthing by @int-e found that the culprit is likely `nix`, although it's not clear why. For now we avoid the issue by setting `HOME` to a fresh directory in the working tree. - - - - - bc7e9f03 by Zubin Duggal at 2021-11-20T17:39:25+00:00 Use 'NonEmpty' for the fields in an 'HsProjection' (#20389) T12545 is very inconsistently affected by this change for some reason. There is a decrease in allocations on most configurations, but an increase on validate-x86_64-linux-deb9-unreg-hadrian. Accepting it as it seems unrelated to this patch. Metric Decrease: T12545 Metric Increase: T12545 - - - - - 742d8b60 by sheaf at 2021-11-20T18:13:23-05:00 Include "not more specific" info in overlap msg When instances overlap, we now include additional information about why we weren't able to select an instance: perhaps one instance overlapped another but was not strictly more specific, so we aren't able to directly choose it. Fixes #20542 - - - - - f748988b by Simon Peyton Jones at 2021-11-22T11:53:02-05:00 Better wrapper activation calculation As #20709 showed, GHC could prioritise a wrapper over a SPEC rule, which is potentially very bad. This patch fixes that problem. The fix is is described in Note [Wrapper activation], especially item 4, 4a, and Conclusion. For now, it has a temporary hack (replicating what was there before to make sure that wrappers inline no earlier than phase 2. But it should be temporary; see #19001. - - - - - f0bac29b by Simon Peyton Jones at 2021-11-22T11:53:02-05:00 Make INLINE/NOINLINE pragmas a bgi less constraining We can inline a bit earlier than the previous pragmas said. I think they dated from an era in which the InitialPhase did no inlining. I don't think this patch will have much effect, but it's a bit cleaner. - - - - - 68a3665a by Sylvain Henry at 2021-11-22T11:53:47-05:00 Hadrian: bump stackage LTS to 18.18 (GHC 8.10.7) - - - - - 680ef2c8 by Andreas Klebinger at 2021-11-23T01:07:29-05:00 CmmSink: Be more aggressive in removing no-op assignments. No-op assignments like R1 = R1 are not only wasteful. They can also inhibit other optimizations like inlining assignments that read from R1. We now check for assignments being a no-op before and after we simplify the RHS in Cmm sink which should eliminate most of these no-ops. - - - - - 1ed2aa90 by Andreas Klebinger at 2021-11-23T01:07:29-05:00 Don't include types in test output - - - - - 3ab3631f by Krzysztof Gogolewski at 2021-11-23T01:08:05-05:00 Add a warning for GADT match + NoMonoLocalBinds (#20485) Previously, it was an error to pattern match on a GADT without GADTs or TypeFamilies. This is now allowed. Instead, we check the flag MonoLocalBinds; if it is not enabled, we issue a warning, controlled by -Wgadt-mono-local-binds. Also fixes #20485: pattern synonyms are now checked too. - - - - - 9dcb2ad1 by Ben Gamari at 2021-11-23T16:09:39+00:00 gitlab-ci: Bump DOCKER_REV - - - - - 16690374 by nineonine at 2021-11-23T22:32:51-08:00 Combine STG free variable traversals (#17978) Previously we would traverse the STG AST twice looking for free variables. * Once in `annTopBindingsDeps` which considers top level and imported ids free. Its output is used to put bindings in dependency order. The pass happens in STG pipeline. * Once in `annTopBindingsFreeVars` which only considers non-top level ids free. Its output is used by the code generator to compute offsets into closures. This happens in Cmm (CodeGen) pipeline. Now these two traversal operations are merged into one - `FVs.depSortWithAnnotStgPgm`. The pass happens right at the end of STG pipeline. Some type signatures had to be updated due to slight shifts of StgPass boundaries (for example, top-level CodeGen handler now directly works with CodeGen flavoured Stg AST instead of Vanilla). Due to changed order of bindings, a few debugger type reconstruction bugs have resurfaced again (see tests break018, break021) - work item #18004 tracks this investigation. authors: simonpj, nineonine - - - - - 91c0a657 by Matthew Pickering at 2021-11-25T01:03:17-05:00 Correct retypechecking in --make mode Note [Hydrating Modules] ~~~~~~~~~~~~~~~~~~~~~~~~ What is hydrating a module? * There are two versions of a module, the ModIface is the on-disk version and the ModDetails is a fleshed-out in-memory version. * We can **hydrate** a ModIface in order to obtain a ModDetails. Hydration happens in three different places * When an interface file is initially loaded from disk, it has to be hydrated. * When a module is finished compiling, we hydrate the ModIface in order to generate the version of ModDetails which exists in memory (see Note) * When dealing with boot files and module loops (see Note [Rehydrating Modules]) Note [Rehydrating Modules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ If a module has a boot file then it is critical to rehydrate the modules on the path between the two. Suppose we have ("R" for "recursive"): ``` R.hs-boot: module R where data T g :: T -> T A.hs: module A( f, T, g ) where import {-# SOURCE #-} R data S = MkS T f :: T -> S = ...g... R.hs: module R where data T = T1 | T2 S g = ...f... ``` After compiling A.hs we'll have a TypeEnv in which the Id for `f` has a type type uses the AbstractTyCon T; and a TyCon for `S` that also mentions that same AbstractTyCon. (Abstract because it came from R.hs-boot; we know nothing about it.) When compiling R.hs, we build a TyCon for `T`. But that TyCon mentions `S`, and it currently has an AbstractTyCon for `T` inside it. But we want to build a fully cyclic structure, in which `S` refers to `T` and `T` refers to `S`. Solution: **rehydration**. *Before compiling `R.hs`*, rehydrate all the ModIfaces below it that depend on R.hs-boot. To rehydrate a ModIface, call `typecheckIface` to convert it to a ModDetails. It's just a de-serialisation step, no type inference, just lookups. Now `S` will be bound to a thunk that, when forced, will "see" the final binding for `T`; see [Tying the knot](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/tying-the-knot). But note that this must be done *before* compiling R.hs. When compiling R.hs, the knot-tying stuff above will ensure that `f`'s unfolding mentions the `LocalId` for `g`. But when we finish R, we carefully ensure that all those `LocalIds` are turned into completed `GlobalIds`, replete with unfoldings etc. Alas, that will not apply to the occurrences of `g` in `f`'s unfolding. And if we leave matters like that, they will stay that way, and *all* subsequent modules that import A will see a crippled unfolding for `f`. Solution: rehydrate both R and A's ModIface together, right after completing R.hs. We only need rehydrate modules that are * Below R.hs * Above R.hs-boot There might be many unrelated modules (in the home package) that don't need to be rehydrated. This dark corner is the subject of #14092. Suppose we add to our example ``` X.hs module X where import A data XT = MkX T fx = ...g... ``` If in `--make` we compile R.hs-boot, then A.hs, then X.hs, we'll get a `ModDetails` for `X` that has an AbstractTyCon for `T` in the the argument type of `MkX`. So: * Either we should delay compiling X until after R has beeen compiled. * Or we should rehydrate X after compiling R -- because it transitively depends on R.hs-boot. Ticket #20200 has exposed some issues to do with the knot-tying logic in GHC.Make, in `--make` mode. this particular issue starts [here](https://gitlab.haskell.org/ghc/ghc/-/issues/20200#note_385758). The wiki page [Tying the knot](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/tying-the-knot) is helpful. Also closely related are * #14092 * #14103 Fixes tickets #20200 #20561 - - - - - f0c5d8d3 by Matthew Pickering at 2021-11-25T01:03:17-05:00 Make T14075 more robust - - - - - 6907e9fa by Matthew Pickering at 2021-11-25T01:03:17-05:00 Revert "Convert lookupIdSubst panic back to a warning (#20200)" This reverts commit df1d808f26544cbb77d85773d672137c65fd3cc7. - - - - - baa8ffee by Greg Steuck at 2021-11-25T01:03:54-05:00 Use getExecutablePath in getBaseDir on OpenBSD While OpenBSD doesn't have a general mechanism for determining the path of the executing program image, it is reasonable to rely on argv[0] which happens as a fallback in getExecutablePath. With this change on top of T18173 we can get a bit close to fixing #18173. - - - - - e3c59191 by Christiaan Baaij at 2021-11-25T01:04:32-05:00 Ensure new Ct/evidence invariant The `ctev_pred` field of a `CtEvidence` is a just a cache for the type of the evidence. More precisely: * For Givens, `ctev_pred` = `varType ctev_evar` * For Wanteds, `ctev_pred` = `evDestType ctev_dest` This new invariant is needed because evidence can become part of a type, via `Castty ty kco`. - - - - - 3639ad8f by Christiaan Baaij at 2021-11-25T01:04:32-05:00 Compare types of recursive let-bindings in alpha-equivalence This commit fixes #20641 by checking the types of recursive let-bindings when performing alpha-equality. The `Eq (DeBruijn CoreExpr)` instance now also compares `BreakPoint`s similarly to `GHC.Core.Utils.eqTickish`, taking bound variables into account. In addition, the `Eq (DeBruijn Type)` instance now correctly compares the kinds of the types when one of them contains a Cast: the instance is modeled after `nonDetCmpTypeX`. - - - - - 7c65687e by CarrieMY at 2021-11-25T01:05:11-05:00 Enable UnboxedTuples in `genInst`, Fixes #20524 - - - - - e33412d0 by Krzysztof Gogolewski at 2021-11-25T01:05:46-05:00 Misc cleanup * Remove `getTag_RDR` (unused), `tidyKind` and `tidyOpenKind` (already available as `tidyType` and `tidyOpenType`) * Remove Note [Explicit Case Statement for Specificity]. Since 0a709dd9876e40 we require GHC 8.10 for bootstrapping. * Change the warning to `cmpAltCon` to a panic. This shouldn't happen. If it ever does, the code was wrong anyway: it shouldn't always return `LT`, but rather `LT` in one case and `GT` in the other case. * Rename `verifyLinearConstructors` to `verifyLinearFields` * Fix `Note [Local record selectors]` which was not referenced * Remove vestiges of `type +v` * Minor fixes to StaticPointers documentation, part of #15603 - - - - - bb71f7f1 by Greg Steuck at 2021-11-25T01:06:25-05:00 Reorder `sed` arguments to work with BSD sed The order was swapped in 490e8c750ea23ce8e2b7309e0d514b7d27f231bb causing the build on OpenBSD to fail with: `sed: 1: "mk/config.h": invalid command code m` - - - - - c18a51f0 by John Ericson at 2021-11-25T01:06:25-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - d530c46c by sheaf at 2021-11-25T01:07:04-05:00 Add Data.Bits changes to base 4.16 changelog Several additions since 4.15 had not been recorded in the changelog: - newtypes And, Ior, Xor and Iff, - oneBits - symbolic synonyms `.^.`, `.>>.`, `!>>.`, `.<<.` and `!<<.`. Fixes #20608. - - - - - 4d34bf15 by Matthew Pickering at 2021-11-25T01:07:40-05:00 Don't use implicit lifting when deriving Lift It isn't much more complicated to be more precise when deriving Lift so we now generate ``` data Foo = Foo Int Bool instance Lift Foo where lift (Foo a b) = [| Foo $(lift a) $(lift b) |] liftTyped (Foo a b) = [|| Foo $$(lift a) $$(lift b) |] ``` This fixes #20688 which complained about using implicit lifting in the derived code. - - - - - 8961d632 by Greg Steuck at 2021-11-25T01:08:18-05:00 Disable warnings for unused goto labels Clang on OpenBSD aborts compilation with this diagnostics: ``` % "inplace/bin/ghc-stage1" -optc-Wno-error=unused-label -optc-Wall -optc-Werror -optc-Wall -optc-Wextra -optc-Wstrict-prototypes -optc-Wmissing-prototypes -optc-Wmissing-declarations -optc-Winline -optc-Wpointer-arith -optc-Wmissing-noreturn -optc-Wnested-externs -optc-Wredundant-decls -optc-Wno-aggregate-return -optc-fno-strict-aliasing -optc-fno-common -optc-Irts/dist-install/build/./autogen -optc-Irts/include/../dist-install/build/include -optc-Irts/include/. -optc-Irts/. -optc-DCOMPILING_RTS -optc-DFS_NAMESPACE=rts -optc-Wno-unknown-pragmas -optc-O2 -optc-fomit-frame-pointer -optc-g -optc-DRtsWay=\"rts_v\" -static -O0 -H64m -Wall -fllvm-fill-undef-with-garbage -Werror -this-unit-id rts -dcmm-lint -package-env - -i -irts -irts/dist-install/build -Irts/dist-install/build -irts/dist-install/build/./autogen -Irts/dist-install/build/./autogen -Irts/include/../dist-install/build/include -Irts/include/. -Irts/. -optP-DCOMPILING_RTS -optP-DFS_NAMESPACE=rts -O2 -Wcpp-undef -Wnoncanonical-monad-instances -c rts/linker/Elf.c -o rts/dist-install/build/linker/Elf.o rts/linker/Elf.c:2169:1: error: error: unused label 'dl_iterate_phdr_fail' [-Werror,-Wunused-label] | 2169 | dl_iterate_phdr_fail: | ^ dl_iterate_phdr_fail: ^~~~~~~~~~~~~~~~~~~~~ rts/linker/Elf.c:2172:1: error: error: unused label 'dlinfo_fail' [-Werror,-Wunused-label] | 2172 | dlinfo_fail: | ^ dlinfo_fail: ^~~~~~~~~~~~ 2 errors generated. ``` - - - - - 5428b8c6 by Zubin Duggal at 2021-11-25T01:08:54-05:00 testsuite: debounce title updates - - - - - 96b3899e by Ben Gamari at 2021-11-25T01:09:29-05:00 gitlab-ci: Add release jobs for Darwin targets As noted in #20707, the validate jobs which we previously used lacked profiling support. Also clean up some variable definitions. Fixes #20707. - - - - - 52cdc2fe by Pepe Iborra at 2021-11-25T05:00:43-05:00 Monoid instance for InstalledModuleEnv - - - - - 47f36440 by Pepe Iborra at 2021-11-25T05:00:43-05:00 Drop instance Semigroup ModuleEnv There is more than one possible Semigroup and it is not needed since plusModuleEnv can be used directly - - - - - b742475a by Pepe Iborra at 2021-11-25T05:00:43-05:00 drop instance Semigroup InstalledModuleEnv Instead, introduce plusInstalledModuleEnv - - - - - b24e8d91 by Roland Senn at 2021-11-25T05:01:21-05:00 GHCi Debugger - Improve RTTI When processing the heap, use also `APClosures` to create additional type constraints. This adds more equations and therefore improves the unification process to infer the correct type of values at breakpoints. (Fix the `incr` part of #19559) - - - - - cf5279ed by Gergő Érdi at 2021-11-25T05:01:59-05:00 Use `simplify` in non-optimizing build pipeline (#20500) - - - - - c9cead1f by Gergő Érdi at 2021-11-25T05:01:59-05:00 Add specific optimization flag for fast PAP calls (#6084, #20500) - - - - - be0a9470 by Gergő Érdi at 2021-11-25T05:01:59-05:00 Add specific optimization flag for Cmm control flow analysis (#20500) - - - - - b52a9a3f by Gergő Érdi at 2021-11-25T05:01:59-05:00 Add `llvmOptLevel` to `DynFlags` (#20500) - - - - - f27a63fe by sheaf at 2021-11-25T05:02:39-05:00 Allow boring class declarations in hs-boot files There are two different ways of declaring a class in an hs-boot file: - a full declaration, where everything is written as it is in the .hs file, - an abstract declaration, where class methods and superclasses are left out. However, a declaration with no methods and a trivial superclass, such as: class () => C a was erroneously considered to be an abstract declaration, because the superclass is trivial. This is remedied by a one line fix in GHC.Tc.TyCl.tcClassDecl1. This patch also further clarifies the documentation around class declarations in hs-boot files. Fixes #20661, #20588. - - - - - cafb1f99 by Ben Gamari at 2021-11-25T05:03:15-05:00 compiler: Mark GHC.Prelude as Haddock no-home This significantly improves Haddock documentation generated by nix. - - - - - bd92c9b2 by Sebastian Graf at 2021-11-25T05:03:51-05:00 hadrian: Add `collect_stats` flavour transformer This is useful for later consumption with https://gitlab.haskell.org/bgamari/ghc-utils/-/blob/master/ghc_timings.py - - - - - 774fc4d6 by Ilias Tsitsimpis at 2021-11-25T08:34:54-05:00 Link against libatomic for 64-bit atomic operations Some platforms (e.g., armel) require linking against libatomic for 64-bit atomic operations. Fixes #20549 - - - - - 20101d9c by Greg Steuck at 2021-11-25T08:35:31-05:00 Permit multiple values in config_args for validate The whitespace expansion should be permitted to pass multiple arguments to configure. - - - - - e2c48b98 by Greg Steuck at 2021-11-25T08:36:09-05:00 Kill a use of %n format specifier This format has been used as a security exploit vector for decades now. Some operating systems (OpenBSD, Android, MSVC). It is targeted for removal in C2X standard: http://www.open-std.org/jtc1/sc22/wg14/www/docs/n2834.htm This requires extending the debug message function to return the number of bytes written (like printf(3)), to permit %n format specifier in one in one invocation of statsPrintf() in report_summary(). Implemented by Matthias Kilian (kili<AT>outback.escape.de) - - - - - ff0c45f3 by Andrew Lelechenko at 2021-11-26T16:01:09-05:00 Rename Data.ByteArray to Data.Array.ByteArray + add Trustworthy - - - - - 9907d540 by Andrew Lelechenko at 2021-11-26T16:01:09-05:00 Rename Data.Array.ByteArray -> Data.Array.Byte - - - - - 0c8e1b4d by Kai Prott at 2021-11-26T16:01:47-05:00 Improve error message for mis-typed plugins #20671 Previously, when a plugin could not be loaded because it was incorrectly typed, the error message only printed the expected but not the actual type. This commit augments the error message such that both types are printed and the corresponding module is printed as well. - - - - - 51bcb986 by Kai Prott at 2021-11-26T16:01:47-05:00 Remove duplicate import - - - - - 1830eea7 by Kai Prott at 2021-11-26T16:01:47-05:00 Simplify printQualification - - - - - 69e62032 by Kai Prott at 2021-11-26T16:01:47-05:00 Fix plugin type to GHC.Plugins.Plugin - - - - - 0a6776a3 by Kai Prott at 2021-11-26T16:01:47-05:00 Adapt plugin test case - - - - - 7e18b304 by Kai Prott at 2021-11-26T16:01:47-05:00 Reflect type change in the haddock comment - - - - - 02372be1 by Matthew Pickering at 2021-11-26T16:02:23-05:00 Allow keywords which can be used as variables to be used with OverloadedDotSyntax There are quite a few keywords which are allowed to be used as variables. Such as "as", "dependency" etc. These weren't accepted by OverloadedDotSyntax. The fix is pretty simple, use the varid production rather than raw VARID. Fixes #20723 - - - - - 13ef345c by John Ericson at 2021-11-27T19:41:11+00:00 Factor our `FP_CAPITALIZE_YES_NO` This deduplicates converting from yes/no to YES/NO in the configure scripts while also making it safer. - - - - - 88481c94 by John Ericson at 2021-11-27T19:46:16+00:00 Fix top-level configure script so --disable-foo works - - - - - f67060c6 by John Ericson at 2021-11-27T19:47:09+00:00 Make ambient MinGW support a proper settings Get rid of `USE_INPLACE_MINGW_TOOLCHAIN` and use a settings file entry instead. The CPP setting was originally introduced in f065b6b012. - - - - - 1dc0d7af by Ben Gamari at 2021-11-29T11:02:43-05:00 linker: Introduce linker_verbose debug output This splits the -Dl RTS debug output into two distinct flags: * `+RTS -Dl` shows errors and debug output which scales with at most O(# objects) * `+RTS -DL` shows debug output which scales with O(# symbols)t - - - - - 7ea665bf by Krzysztof Gogolewski at 2021-11-29T11:03:19-05:00 TTG: replace Void/NoExtCon with DataConCantHappen There were two ways to indicate that a TTG constructor is unused in a phase: `NoExtCon` and `Void`. This unifies the code, and uses the name 'DataConCantHappen', following the discussion at MR 7041. Updates haddock submodule - - - - - 14e9cab6 by Sylvain Henry at 2021-11-29T11:04:03-05:00 Use Monoid in hptSomeThingsBelowUs It seems to have a moderate but good impact on perf tests in CI. In particular: MultiLayerModules(normal) ghc/alloc 3125771138.7 3065532240.0 -1.9% So it's likely that huge projects will benefit from this. - - - - - 22bbf449 by Anton-Latukha at 2021-11-29T20:03:52+00:00 docs/users_guide/bugs.rst: Rewording It is either "slightly" || "significantly". If it is "bogus" - then no quotes around "optimization" & overall using word "bogus" or use quotes in that way in documentation is... Instead, something like "hack" or "heuristic" can be used there. - - - - - 9345bfed by Mitchell Rosen at 2021-11-30T01:32:22-05:00 Fix caluclation of nonmoving GC elapsed time Fixes #20751 - - - - - c7613493 by PHO at 2021-12-01T03:07:32-05:00 rts/ProfHeap.c: Use setlocale() on platforms where uselocale() is not available Not all platforms have per-thread locales. NetBSD doesn't have uselocale() in particular. Using setlocale() is of course not a safe thing to do, but it would be better than no GHC at all. - - - - - 4acfa0db by Ben Gamari at 2021-12-01T03:08:07-05:00 rts: Refactor SRT representation selection The goal here is to make the SRT selection logic a bit clearer and allow configurations which we currently don't support (e.g. using a full word in the info table even when TNTC is used). - - - - - 87bd9a67 by Ben Gamari at 2021-12-01T03:08:07-05:00 gitlab-ci: Introduce no_tntc job A manual job for testing the non-tables-next-to-code configuration. - - - - - 7acb945d by Carrie Xu at 2021-12-01T03:08:46-05:00 Dump non-module specific info to file #20316 - Change the dumpPrefix to FilePath, and default to non-module - Add dot to seperate dump-file-prefix and suffix - Modify user guide to introduce how dump files are named - This commit does not affect Ghci dump file naming. See also #17500 - - - - - 7bdca2ba by Ben Gamari at 2021-12-01T03:09:21-05:00 rts/RtsSymbols: Provide a proper prototype for environ Previously we relied on Sym_NeedsProto, but this gave the symbol a type which conflicts with the definition that may be provided by unistd.h. Fixes #20577. - - - - - 91d1a773 by Ben Gamari at 2021-12-01T03:09:21-05:00 hadrian: Don't pass empty paths via -I Previously we could in some cases add empty paths to `cc`'s include file search path. See #20578. - - - - - d8d57729 by Ben Gamari at 2021-12-01T03:09:21-05:00 ghc-cabal: Manually specify -XHaskell2010 Otherwise we end up with issues like #19631 when bootstrapping using GHC 9.2 and above. Fixes #19631. - - - - - 1c0c140a by Ben Gamari at 2021-12-01T03:09:21-05:00 ghc-compact: Update cabal file Improve documentation, bump bounds and cabal-version. - - - - - 322b6b45 by Ben Gamari at 2021-12-01T03:09:21-05:00 hadrian: Document fully_static flavour transformer - - - - - 4c434c9e by Ben Gamari at 2021-12-01T03:09:21-05:00 user-guide: Fix :since: of -XCApiFFI Closes #20504. - - - - - 0833ad55 by Matthew Pickering at 2021-12-01T03:09:58-05:00 Add failing test for #20674 - - - - - c2cb5e9a by Ben Gamari at 2021-12-01T03:10:34-05:00 testsuite: Print geometric mean of stat metrics As suggested in #20733. - - - - - 59b27945 by Ben Gamari at 2021-12-01T03:11:09-05:00 users-guide: Describe requirements of DWARF unwinding As requested in #20702 - - - - - c2f6cbef by Matthew Pickering at 2021-12-01T03:11:45-05:00 Fix several quoting issues in testsuite This fixes the ./validate script on my machine. I also took the step to add some linters which would catch problems like these in future. Fixes #20506 - - - - - bffd4074 by John Ericson at 2021-12-01T03:12:21-05:00 rts.cabal.in: Move `extra-source-files` so it is valid - - - - - 86c14db5 by John Ericson at 2021-12-01T03:12:21-05:00 Switch RTS cabal file / package conf to use Rts.h not Stg.h When we give cabal a configure script, it seems to begin checking whether or not Stg.h is valid, and then gets tripped up on all the register stuff which evidentally requires obscure command line flags to go. We can side-step this by making the test header Rts.h instead, which is more normal. I was a bit sketched out making this change, as I don't know why the Cabal library would suddenly beging checking the header. But I did confirm even without my RTS configure script the header doesn't compile stand-alone, and also the Stg.h is a probably-arbitrary choice since it dates all the way back to 2002 in 2cc5b907318f97e19b28b2ad8ed9ff8c1f401dcc. - - - - - defd8d54 by John Ericson at 2021-12-01T03:12:21-05:00 Avoid raw `echo` in `FPTOOLS_SET_PLATFORM_VARS` This ensures quiet configuring works. - - - - - b53f1227 by John Ericson at 2021-12-01T03:12:21-05:00 Factor our `$dir_$distdir_PKGDATA` make variable This makes a few things cleaner. - - - - - f124f2a0 by Ben Gamari at 2021-12-01T03:12:56-05:00 rts: Annotate benign race in pthread ticker's exit test Previously TSAN would report spurious data races due to the unsynchronized access of `exited`. I would have thought that using a relaxed load on `exited` would be enough to convince TSAN that the race was intentional, but apparently not. Closes #20690. - - - - - d3c7f9be by Viktor Dukhovni at 2021-12-01T03:13:34-05:00 Use POSIX shell syntax to redirect stdout/err FreeBSD (and likely NetBSD) /bin/sh does not support '>& word' to redirect stdout + stderr. (Also the preferred syntax in bash would be '&> word' to avoid surprises when `word` is "-" or a number). Resolves: #20760 - - - - - 1724ac37 by Ben Gamari at 2021-12-02T18:13:30-05:00 nativeGen/x86: Don't encode large shift offsets Handle the case of a shift larger than the width of the shifted value. This is necessary since x86 applies a mask of 0x1f to the shift amount, meaning that, e.g., `shr 47, $eax` will actually shift by 47 & 0x1f == 15. See #20626. (cherry picked from commit 31370f1afe1e2f071b3569fb5ed4a115096127ca) - - - - - 5b950a7f by Ben Gamari at 2021-12-02T18:13:30-05:00 cmm: narrow when folding signed quotients Previously the constant-folding behavior for MO_S_Quot and MO_S_Rem failed to narrow its arguments, meaning that a program like: %zx64(%quot(%lobits8(0x00e1::bits16), 3::bits8)) would be miscompiled. Specifically, this program should reduce as %lobits8(0x00e1::bits16) == -31 %quot(%lobits8(0x00e1::bits16), 3::bits8) == -10 %zx64(%quot(%lobits8(0x00e1::bits16), 3::bits8)) == 246 However, with this bug the `%lobits8(0x00e1::bits16)` would instead be treated as `+31`, resulting in the incorrect result of `75`. (cherry picked from commit 94e197e3dbb9a48991eb90a03b51ea13d39ba4cc) - - - - - 78b78ac4 by Ben Gamari at 2021-12-02T18:13:30-05:00 ncg/aarch64: Don't sign extend loads Previously we would emit the sign-extending LDS[HB] instructions for sub-word loads. However, this is wrong, as noted in #20638. - - - - - 35bbc251 by Ben Gamari at 2021-12-02T18:13:30-05:00 cmm: Disallow shifts larger than shiftee Previously primops.txt.pp stipulated that the word-size shift primops were only defined for shift offsets in [0, word_size). However, there was no further guidance for the definition of Cmm's sub-word size shift MachOps. Here we fix this by explicitly disallowing (checked in many cases by CmmLint) shift operations where the shift offset is larger than the shiftee. This is consistent with LLVM's shift operations, avoiding the miscompilation noted in #20637. - - - - - 2f6565cf by Ben Gamari at 2021-12-02T18:13:30-05:00 testsuite: Add testcases for various machop issues There were found by the test-primops testsuite. - - - - - 7094f4fa by Ben Gamari at 2021-12-02T18:13:30-05:00 nativeGen/aarch64: Don't rely on register width to determine amode We might be loading, e.g., a 16- or 8-bit value, in which case the register width is not reflective of the loaded element size. - - - - - 9c65197e by Ben Gamari at 2021-12-02T18:13:30-05:00 cmm/opt: Fold away shifts larger than shiftee width This is necessary for lint-correctness since we no longer allow such shifts in Cmm. - - - - - adc7f108 by Ben Gamari at 2021-12-02T18:13:30-05:00 nativeGen/aarch64: Fix handling of subword values Here we rework the handling of sub-word operations in the AArch64 backend, fixing a number of bugs and inconsistencies. In short, we now impose the invariant that all subword values are represented in registers in zero-extended form. Signed arithmetic operations are then responsible for sign-extending as necessary. Possible future work: * Use `CMP`s extended register form to avoid burning an instruction in sign-extending the second operand. * Track sign-extension state of registers to elide redundant sign extensions in blocks with frequent sub-word signed arithmetic. - - - - - e19e9e71 by Ben Gamari at 2021-12-02T18:13:31-05:00 CmmToC: Fix width of shift operations Under C's implicit widening rules, the result of an operation like (a >> b) where a::Word8 and b::Word will have type Word, yet we want Word. - - - - - ebaf7333 by Ben Gamari at 2021-12-02T18:13:31-05:00 CmmToC: Zero-extend sub-word size results As noted in Note [Zero-extending sub-word signed results] we must explicitly zero-extend the results of sub-word-sized signed operations. - - - - - 0aeaa8f3 by Ben Gamari at 2021-12-02T18:13:31-05:00 CmmToC: Always cast arguments as unsigned As noted in Note [When in doubt, cast arguments as unsigned], we must ensure that arguments have the correct signedness since some operations (e.g. `%`) have different semantics depending upon signedness. - - - - - e98dad1b by Ben Gamari at 2021-12-02T18:13:31-05:00 CmmToC: Cast possibly-signed results as unsigned C11 rule 6.3.1.1 dictates that all small integers used in expressions be implicitly converted to `signed int`. However, Cmm semantics require that the width of the operands be preserved with zero-extension semantics. For this reason we must recast sub-word arithmetic results as unsigned. - - - - - 44c08863 by Ben Gamari at 2021-12-02T18:13:31-05:00 testsuite: Specify expected word-size of machop tests These generally expect a particular word size. - - - - - fab2579e by Ben Gamari at 2021-12-02T18:14:06-05:00 hadrian: Don't rely on realpath in bindist Makefile As noted in #19963, `realpath` is not specified by POSIX and therefore cannot be assumed to be available. Here we provide a POSIX shell implementation of `realpath`, due to Julian Ospald and others. Closes #19963. - - - - - 99eb54bd by Kamil Dworakowski at 2021-12-02T21:45:10-05:00 Make openFile more tolerant of async excs (#18832) - - - - - 0e274c39 by nineonine at 2021-12-02T21:45:49-05:00 Require all dirty_MUT_VAR callers to do explicit stg_MUT_VAR_CLEAN_info comparison (#20088) - - - - - 81082cf4 by Matthew Pickering at 2021-12-03T10:12:04-05:00 Revert "Data.List specialization to []" This reverts commit bddecda1a4c96da21e3f5211743ce5e4c78793a2. This implements the first step in the plan formulated in #20025 to improve the communication and migration strategy for the proposed changes to Data.List. Requires changing the haddock submodule to update the test output. - - - - - a9e035a4 by sheaf at 2021-12-03T10:12:42-05:00 Test-suite: fix geometric mean of empty list The geometric mean computation panicked when it was given an empty list, which happens when there are no baselines. Instead, we should simply return 1. - - - - - d72720f9 by Matthew Pickering at 2021-12-06T16:27:35+00:00 Add section to the user guide about OS memory usage - - - - - 0fe45d43 by Viktor Dukhovni at 2021-12-07T06:27:12-05:00 List-monomorphic `foldr'` While a *strict* (i.e. constant space) right-fold on lists is not possible, the default `foldr'` is optimised for structures like `Seq`, that support efficient access to the right-most elements. The original default implementation seems to have a better constant factor for lists, so we add a monomorphic implementation in GHC.List. Should this be re-exported from `Data.List`? That would be a user-visible change if both `Data.Foldable` and `Data.List` are imported unqualified... - - - - - 7d2283b9 by Ben Gamari at 2021-12-07T06:27:47-05:00 compiler: Eliminate accidental loop in GHC.SysTools.BaseDir As noted in #20757, `GHC.SysTools.BaseDir.findToolDir` previously contained an loop, which would be triggered in the case that the search failed. Closes #20757. - - - - - 8044e232 by Viktor Dukhovni at 2021-12-07T06:28:23-05:00 More specific documentation of foldr' caveats - - - - - d932e2d6 by Viktor Dukhovni at 2021-12-07T06:28:23-05:00 Use italic big-O notation in Data.Foldable - - - - - 57c9c0a2 by Viktor Dukhovni at 2021-12-07T06:28:23-05:00 Fix user-guide typo - - - - - 324772bb by Ben Gamari at 2021-12-07T06:28:59-05:00 rts/Linker: Ensure that mmap_32bit_base is updated after mapping The amount of duplicated code in `mmapForLinker` hid the fact that some codepaths would fail to update `mmap_32bit_base` (specifically, on platforms like OpenBSD where `MAP_32BIT` is not supported). Refactor the function to make the implementation more obviously correct. Closes #20734. - - - - - 5dbdf878 by Ben Gamari at 2021-12-07T06:28:59-05:00 rts: +RTS -DL should imply +RTS -Dl Otherwise the user may be surprised by the missing context provided by the latter. - - - - - 7eb56064 by sheaf at 2021-12-07T06:29:38-05:00 More permissive parsing of higher-rank type IPs The parser now accepts implicit parameters with higher-rank types, such as `foo :: (?ip :: forall a. a -> a) => ...` Before this patch, we instead insisted on parentheses like so: `foo :: (?ip :: (forall a. a -> a)) => ...` The rest of the logic surrounding implicit parameters is unchanged; in particular, even with ImpredicativeTypes, this idiom is not likely to be very useful. Fixes #20654 - - - - - 427f9c12 by sheaf at 2021-12-07T13:32:55-05:00 Re-export GHC.Types from GHC.Exts Several times in the past, it has happened that things from GHC.Types were not re-exported from GHC.Exts, forcing users to import either GHC.Types or GHC.Prim, which are subject to internal change without notice. We now re-export GHC.Types from GHC.Exts, which should avoid this happening again in the future. In particular, we now re-export `Multiplicity` and `MultMul`, which we didn't before. Fixes #20695 - - - - - 483bd04d by Sebastian Graf at 2021-12-07T13:33:31-05:00 Explicit Data.List import list in check-ppr (#20789) `check-ppr` features an import of Data.List without an import list. After 81082cf4, this breaks the local validate flavour because of the compat warning and `-Werror`. So fix that. Fixes #20789. - - - - - cc2bf8e9 by Norman Ramsey at 2021-12-07T17:34:51-05:00 generalize GHC.Cmm.Dataflow to work over any node type See #20725. The commit includes source-code changes and a test case. - - - - - 4c6985cc by Sylvain Henry at 2021-12-07T17:35:30-05:00 Perf: remove an indirection when fetching the unique mask Slight decrease but still noticeable on CI: Baseline Test Metric value New value Change ----------------------------------------------------------------------------- ManyAlternatives(normal) ghc/alloc 747607676.0 747458936.0 -0.0% ManyConstructors(normal) ghc/alloc 4003722296.0 4003530032.0 -0.0% MultiLayerModules(normal) ghc/alloc 3064539560.0 3063984552.0 -0.0% MultiLayerModulesRecomp(normal) ghc/alloc 894700016.0 894700624.0 +0.0% PmSeriesG(normal) ghc/alloc 48410952.0 48262496.0 -0.3% PmSeriesS(normal) ghc/alloc 61561848.0 61415768.0 -0.2% PmSeriesT(normal) ghc/alloc 90975784.0 90829360.0 -0.2% PmSeriesV(normal) ghc/alloc 60405424.0 60259008.0 -0.2% T10421(normal) ghc/alloc 113275928.0 113137168.0 -0.1% T10421a(normal) ghc/alloc 79195676.0 79050112.0 -0.2% T10547(normal) ghc/alloc 28720176.0 28710008.0 -0.0% T10858(normal) ghc/alloc 180992412.0 180857400.0 -0.1% T11195(normal) ghc/alloc 283452220.0 283293832.0 -0.1% T11276(normal) ghc/alloc 137882128.0 137745840.0 -0.1% T11303b(normal) ghc/alloc 44453956.0 44309184.0 -0.3% T11374(normal) ghc/alloc 248118668.0 247979880.0 -0.1% T11545(normal) ghc/alloc 971994728.0 971852696.0 -0.0% T11822(normal) ghc/alloc 131544864.0 131399024.0 -0.1% T12150(optasm) ghc/alloc 79336468.0 79191888.0 -0.2% T12227(normal) ghc/alloc 495064180.0 494943040.0 -0.0% T12234(optasm) ghc/alloc 57198468.0 57053568.0 -0.3% T12425(optasm) ghc/alloc 90928696.0 90793440.0 -0.1% T12545(normal) ghc/alloc 1695417772.0 1695275744.0 -0.0% T12707(normal) ghc/alloc 956258984.0 956138864.0 -0.0% T13035(normal) ghc/alloc 102279484.0 102132616.0 -0.1% T13056(optasm) ghc/alloc 367196556.0 367066408.0 -0.0% T13253(normal) ghc/alloc 334365844.0 334255264.0 -0.0% T13253-spj(normal) ghc/alloc 125474884.0 125328672.0 -0.1% T13379(normal) ghc/alloc 359185604.0 359036960.0 -0.0% T13701(normal) ghc/alloc 2403026480.0 2402677464.0 -0.0% T13719(normal) ghc/alloc 4192234752.0 4192039448.0 -0.0% T14052(ghci) ghc/alloc 2745868552.0 2747706176.0 +0.1% T14052Type(ghci) ghc/alloc 7335937964.0 7336283280.0 +0.0% T14683(normal) ghc/alloc 2992557736.0 2992436872.0 -0.0% T14697(normal) ghc/alloc 363391248.0 363222920.0 -0.0% T15164(normal) ghc/alloc 1292578008.0 1292434240.0 -0.0% T15304(normal) ghc/alloc 1279603472.0 1279465944.0 -0.0% T15630(normal) ghc/alloc 161707776.0 161602632.0 -0.1% T16190(normal) ghc/alloc 276904644.0 276555264.0 -0.1% T16577(normal) ghc/alloc 7573033016.0 7572982752.0 -0.0% T16875(normal) ghc/alloc 34937980.0 34796592.0 -0.4% T17096(normal) ghc/alloc 287436348.0 287299368.0 -0.0% T17516(normal) ghc/alloc 1714727484.0 1714617664.0 -0.0% T17836(normal) ghc/alloc 1091095748.0 1090958168.0 -0.0% T17836b(normal) ghc/alloc 52467912.0 52321296.0 -0.3% T17977(normal) ghc/alloc 44971660.0 44826480.0 -0.3% T17977b(normal) ghc/alloc 40941128.0 40793160.0 -0.4% T18140(normal) ghc/alloc 82363124.0 82213056.0 -0.2% T18223(normal) ghc/alloc 1168448128.0 1168333624.0 -0.0% T18282(normal) ghc/alloc 131577844.0 131440400.0 -0.1% T18304(normal) ghc/alloc 86988664.0 86844432.0 -0.2% T18478(normal) ghc/alloc 742992400.0 742871136.0 -0.0% T18698a(normal) ghc/alloc 337654412.0 337526792.0 -0.0% T18698b(normal) ghc/alloc 398840772.0 398716472.0 -0.0% T18923(normal) ghc/alloc 68964992.0 68818768.0 -0.2% T1969(normal) ghc/alloc 764285884.0 764156168.0 -0.0% T19695(normal) ghc/alloc 1395577984.0 1395552552.0 -0.0% T20049(normal) ghc/alloc 89159032.0 89012952.0 -0.2% T3064(normal) ghc/alloc 191194856.0 191051816.0 -0.1% T3294(normal) ghc/alloc 1604762016.0 1604656488.0 -0.0% T4801(normal) ghc/alloc 296829368.0 296687824.0 -0.0% T5030(normal) ghc/alloc 364720540.0 364580152.0 -0.0% T5321FD(normal) ghc/alloc 271090004.0 270950824.0 -0.1% T5321Fun(normal) ghc/alloc 301244320.0 301102960.0 -0.0% T5631(normal) ghc/alloc 576154548.0 576022904.0 -0.0% T5642(normal) ghc/alloc 471105876.0 470967552.0 -0.0% T5837(normal) ghc/alloc 36328620.0 36186720.0 -0.4% T6048(optasm) ghc/alloc 103125988.0 102981024.0 -0.1% T783(normal) ghc/alloc 386945556.0 386795984.0 -0.0% T9020(optasm) ghc/alloc 247835012.0 247696704.0 -0.1% T9198(normal) ghc/alloc 47556208.0 47413784.0 -0.3% T9233(normal) ghc/alloc 682210596.0 682069960.0 -0.0% T9630(normal) ghc/alloc 1429689648.0 1429581168.0 -0.0% T9675(optasm) ghc/alloc 431092812.0 430943192.0 -0.0% T9872a(normal) ghc/alloc 1705052592.0 1705042064.0 -0.0% T9872b(normal) ghc/alloc 2180406760.0 2180395784.0 -0.0% T9872c(normal) ghc/alloc 1760508464.0 1760497936.0 -0.0% T9872d(normal) ghc/alloc 501517968.0 501309464.0 -0.0% T9961(normal) ghc/alloc 354037204.0 353891576.0 -0.0% TcPlugin_RewritePerf(normal) ghc/alloc 2381708520.0 2381550824.0 -0.0% WWRec(normal) ghc/alloc 589553520.0 589407216.0 -0.0% hard_hole_fits(normal) ghc/alloc 492122188.0 492470648.0 +0.1% hie002(normal) ghc/alloc 9336434800.0 9336443496.0 +0.0% parsing001(normal) ghc/alloc 537680944.0 537659824.0 -0.0% geo. mean -0.1% - - - - - aafa5079 by Andrew Lelechenko at 2021-12-09T04:26:35-05:00 Bump bytestring submodule to 0.11.2.0 Both tests import `Data.ByteString`, so the change in allocations is more or less expected. Metric Increase: T19695 T9630 - - - - - 803eefb1 by Matthew Pickering at 2021-12-09T04:27:11-05:00 package imports: Take into account package visibility when renaming In 806e49ae the package imports refactoring code was modified to rename package imports. There was a small oversight which meant the code didn't account for module visibility. This patch fixes that oversight. In general the "lookupPackageName" function is unsafe to use as it doesn't account for package visiblity/thinning/renaming etc, there is just one use in the compiler which would be good to audit. Fixes #20779 - - - - - 52bbea0f by Viktor Dukhovni at 2021-12-09T04:27:48-05:00 Fix typo and outdated link in Data.Foldable Amazing nobody had reported the "Foldabla" typo. :-( The Traversable docs got overhauled, leaving a stale link in Foldable to a section that got replaced. Gave the new section an anchor and updated the link. - - - - - a722859f by Viktor Dukhovni at 2021-12-09T04:27:48-05:00 A few more typos - - - - - d6177cb5 by Viktor Dukhovni at 2021-12-09T04:27:48-05:00 Drop O(n^2) warning on concat - - - - - 9f988525 by David Feuer at 2021-12-09T13:49:47+00:00 Improve mtimesDefault * Make 'mtimesDefault' use 'stimes' for the underlying monoid rather than the default 'stimes'. * Explain in the documentation why one might use `mtimesDefault`. - - - - - 2fca50d4 by Gergő Érdi at 2021-12-09T22:14:24-05:00 Use same optimization pipeline regardless of `optLevel` (#20500) - - - - - 6d031922 by Gergő Érdi at 2021-12-09T22:14:24-05:00 Add `Opt_CoreConstantFolding` to turn on constant folding (#20500) Previously, `-O1` and `-O2`, by way of their effect on the compilation pipeline, they implicitly turned on constant folding - - - - - b6f7d145 by Gergő Érdi at 2021-12-09T22:14:24-05:00 Remove `optLevel` from `DynFlags` (closes #20500) - - - - - 724df9c3 by Ryan Scott at 2021-12-09T22:15:00-05:00 Hadrian: Allow building with GHC 9.2 A separate issue is the fact that many of `hadrian`'s modules produce `-Wincomplete-uni-patterns` warnings under 9.2, but that is probably best left to a separate patch. - - - - - 80a25502 by Matthew Pickering at 2021-12-09T22:15:35-05:00 Use file hash cache when hashing object file dependencies This fixes the immediate problem that we hash the same file multiple different times which causes quite a noticeably performance regression. In the future we can probably do better than this by storing the implementation hash in the interface file rather than dependending on hashing the object file. Related to #20604 which notes some inefficiencies with the current recompilation logic. Closes #20790 ------------------------- Metric Decrease: T14052Type ------------------------- - - - - - f573cb16 by nineonine at 2021-12-10T06:16:41-05:00 rts: use allocation helpers from RtsUtils Just a tiny cleanup inspired by the following comment: https://gitlab.haskell.org/ghc/ghc/-/issues/19437#note_334271 I was just getting familiar with rts code base so I thought might as well do this. - - - - - 16eab39b by Matthew Pickering at 2021-12-10T06:17:16-05:00 Remove confusing haddock quotes in 'readInt' documentation As pointed out in #20776, placing quotes in this way linked to the 'Integral' type class which is nothing to do with 'readInt', the text should rather just be "integral", to suggest that the argument must be an integer. Closes #20776 - - - - - b4a55419 by Ben Gamari at 2021-12-10T06:17:52-05:00 docs: Drop old release notes Closes #20786 - - - - - 8d1f30e7 by Jakob Brünker at 2021-12-11T00:55:48-05:00 Add PromotedInfixT/PromotedUInfixT to TH Previously, it was not possible to refer to a data constructor using InfixT with a dynamically bound name (i.e. a name with NameFlavour `NameS` or `NameQ`) if a type constructor of the same name exists. This commit adds promoted counterparts to InfixT and UInfixT, analogously to how PromotedT is the promoted counterpart to ConT. Closes #20773 - - - - - 785859fa by Andrew Lelechenko at 2021-12-11T00:56:26-05:00 Bump text submodule to 2.0-rc2 - - - - - 352284de by Sylvain Henry at 2021-12-11T00:57:05-05:00 Perf: remove allocation in writeBlocks and fix comment (#14309) - - - - - 40a44f68 by Douglas Wilson at 2021-12-12T09:09:30-05:00 rts: correct stats when running with +RTS -qn1 Despite the documented care having been taken, several bugs are fixed here. When run with -qn1, when a SYNC_GC_PAR is requested we will have n_gc_threads == n_capabilities && n_gc_idle_threads == (n_gc_threads - 1) In this case we now: * Don't increment par_collections * Don't increment par_balanced_copied * Don't emit debug traces for idle threads * Take the fast path in scavenge_until_all_done, wakeup_gc_threads, and shutdown_gc_threads. Some ASSERTs have also been tightened. Fixes #19685 - - - - - 6b2947d2 by Matthew Pickering at 2021-12-12T09:10:06-05:00 iserv: Remove network dependent parts of libiserv As noted in #20794 the parts of libiserv and iserv-proxy depend on network, therefore are never built nor tested during CI. Due to this iserv-proxy had bitrotted due to the bound on bytestring being out of date. Given we don't test this code it seems undesirable to distribute it. Therefore, it's removed and an external maintainer can be responsible for testing it (via head.hackage if desired). Fixes #20794 - - - - - f04d1a49 by Ben Gamari at 2021-12-12T09:10:41-05:00 gitlab-ci: Bump fedora jobs to use Fedora 33 Annoyingly, this will require downstream changes in head.hackage, which depends upon the artifact produced by this job. Prompted by !6462. - - - - - 93783e6a by Andrey Mokhov at 2021-12-12T09:11:20-05:00 Drop --configure from Hadrian docs - - - - - 31bf380f by Oleg Grenrus at 2021-12-12T12:52:18-05:00 Use HasCallStack and error in GHC.List and .NonEmpty In addition to providing stack traces, the scary HasCallStack will hopefully make people think whether they want to use these functions, i.e. act as a documentation hint that something weird might happen. A single metric increased, which doesn't visibly use any method with `HasCallStack`. ------------------------- Metric Decrease: T9630 Metric Decrease: T19695 T9630 ------------------------- - - - - - 401ddd53 by Greg Steuck at 2021-12-12T12:52:56-05:00 Respect W^X in Linker.c:preloadObjectFile on OpenBSD This fixes -fexternal-interpreter for ghci. Fixes #20814. - - - - - c43ee6b8 by Andreas Klebinger at 2021-12-14T19:24:20+01:00 GHC.Utils.Misc.only: Add doc string. This function expects a singleton list as argument but only checks this in debug builds. I've added a docstring saying so. Fixes #20797 - - - - - 9ff54ea8 by Vaibhav Sagar at 2021-12-14T20:50:08-05:00 Data.Functor.Classes: fix Ord1 instance for Down - - - - - 8a2de3c2 by Tamar Christina at 2021-12-14T20:50:47-05:00 rts: update xxhash used by the linker's hashmap - - - - - 1c8d609a by alirezaghey at 2021-12-14T20:51:25-05:00 fix ambiguity in `const` documentation fixes #20412 - - - - - a5d8d47f by Joachim Breitner at 2021-12-14T20:52:00-05:00 Ghci environment: Do not remove shadowed ids Names defined earier but shadowed need to be kept around, e.g. for type signatures: ``` ghci> data T = T ghci> let t = T ghci> data T = T ghci> :t t t :: Ghci1.T ``` and indeed they can be used: ``` ghci> let t2 = Ghci1.T :: Ghci1.T ghci> :t t2 t2 :: Ghci1.T ``` However, previously this did not happen for ids (non-types), although they are still around under the qualified name internally: ``` ghci> let t = "other t" ghci> t' <interactive>:8:1: error: • Variable not in scope: t' • Perhaps you meant one of these: ‘Ghci2.t’ (imported from Ghci2), ‘t’ (line 7), ‘t2’ (line 5) ghci> Ghci2.t <interactive>:9:1: error: • GHC internal error: ‘Ghci2.t’ is not in scope during type checking, but it passed the renamer tcl_env of environment: [] • In the expression: Ghci2.t In an equation for ‘it’: it = Ghci2.t ``` This fixes the problem by simply removing the code that tries to remove shadowed ids from the environment. Now you can refer to shadowed ids using `Ghci2.t`, just like you can do for data and type constructors. This simplifies the code, makes terms and types more similar, and also fixes #20455. Now all names ever defined in GHCi are in `ic_tythings`, which is printed by `:show bindings`. But for that commands, it seems to be more ergonomic to only list those bindings that are not shadowed. Or, even if it is not more ergonomic, it’s the current behavour. So let's restore that by filtering in `icInScopeTTs`. Of course a single `TyThing` can be associated with many names. We keep it it in the bindings if _any_ of its names are still visible unqualifiedly. It's a judgement call. This commit also turns a rather old comment into a test files. The comment is is rather stale and things are better explained elsewhere. Fixes #925. Two test cases are regressing: T14052(ghci) ghc/alloc 2749444288.0 12192109912.0 +343.4% BAD T14052Type(ghci) ghc/alloc 7365784616.0 10767078344.0 +46.2% BAD This is not unexpected; the `ic_tythings list grows` a lot more if we don’t remove shadowed Ids. I tried to alleviate it a bit with earlier MRs, but couldn’t make up for it completely. Metric Increase: T14052 T14052Type - - - - - 7c2609d8 by Cheng Shao at 2021-12-14T20:52:37-05:00 base: fix clockid_t usage when it's a pointer type in C Closes #20607. - - - - - 55cb2aa7 by MichaWiedenmann1 at 2021-12-14T20:53:16-05:00 Fixes typo in documentation of the Semigroup instance of Equivalence - - - - - 82c39f4d by Ben Gamari at 2021-12-14T20:53:51-05:00 users-guide: Fix documentation for -shared flag This flag was previously called `--mk-dll`. It was renamed to `-shared` in b562cbe381d54e08dcafa11339e9a82e781ad557 but the documentation wasn't updated to match. - - - - - 4f654071 by Ben Gamari at 2021-12-14T20:53:51-05:00 compiler: Drop `Maybe ModLocation` from T_MergeForeign This field was entirely unused. - - - - - 71ecb55b by Ben Gamari at 2021-12-14T20:53:51-05:00 compiler: Use withFile instead of bracket A minor refactoring noticed by hlint. - - - - - 5686f47b by Ben Gamari at 2021-12-14T20:53:51-05:00 ghc-bin: Add --merge-objs mode This adds a new mode, `--merge-objs`, which can be used to produce merged GHCi library objects. As future work we will rip out the object-merging logic in Hadrian and Cabal and instead use this mode. Closes #20712. - - - - - 0198bb11 by Ben Gamari at 2021-12-14T20:54:27-05:00 libiserv: Rename Lib module to IServ As proposed in #20546. - - - - - ecaec722 by doyougnu at 2021-12-14T20:55:06-05:00 CmmToLlvm: Remove DynFlags, add LlvmCgConfig CodeOutput: LCGConfig, add handshake initLCGConfig Add two modules: GHC.CmmToLlvm.Config -- to hold the Llvm code gen config GHC.Driver.Config.CmmToLlvm -- for initialization, other utils CmmToLlvm: remove HasDynFlags, add LlvmConfig CmmToLlvm: add lcgContext to LCGConfig CmmToLlvm.Base: DynFlags --> LCGConfig Llvm: absorb LlvmOpts into LCGConfig CmmToLlvm.Ppr: swap DynFlags --> LCGConfig CmmToLlvm.CodeGen: swap DynFlags --> LCGConfig CmmToLlvm.CodeGen: swap DynFlags --> LCGConfig CmmToLlvm.Data: swap LlvmOpts --> LCGConfig CmmToLlvm: swap DynFlags --> LCGConfig CmmToLlvm: move LlvmVersion to CmmToLlvm.Config Additionally: - refactor Config and initConfig to hold LlvmVersion - push IO needed to get LlvmVersion to boundary between Cmm and LLvm code generation - remove redundant imports, this is much cleaner! CmmToLlvm.Config: store platformMisc_llvmTarget instead of all of platformMisc - - - - - 6b0fb9a0 by doyougnu at 2021-12-14T20:55:06-05:00 SysTools.Tasks Llvm.Types: remove redundant import Llvm.Types: remove redundant import SysTools.Tasks: remove redundant import - namely CmmToLlvm.Base - - - - - 80016022 by doyougnu at 2021-12-14T20:55:06-05:00 LLVM.CodeGen: use fast-string literals That is remove factorization of common strings and string building code for the LLVM code gen ops. Replace these with string literals to obey the FastString rewrite rule in GHC.Data.FastString and compute the string length at compile time - - - - - bc663f87 by doyougnu at 2021-12-14T20:55:06-05:00 CmmToLlvm.Config: strictify LlvmConfig field - - - - - 70f0aafe by doyougnu at 2021-12-14T20:55:06-05:00 CmmToLlvm: rename LCGConfig -> LlvmCgConfig CmmToLlvm: renamce lcgPlatform -> llvmCgPlatform CmmToLlvm: rename lcgContext -> llvmCgContext CmmToLlvm: rename lcgFillUndefWithGarbage CmmToLlvm: rename lcgSplitSections CmmToLlvm: lcgBmiVersion -> llvmCgBmiVersion CmmToLlvm: lcgLlvmVersion -> llvmCgLlvmVersion CmmToLlvm: lcgDoWarn -> llvmCgDoWarn CmmToLlvm: lcgLlvmConfig -> llvmCgLlvmConfig CmmToLlvm: llvmCgPlatformMisc --> llvmCgLlvmTarget - - - - - 34abbd81 by Greg Steuck at 2021-12-14T20:55:43-05:00 Add OpenBSD to llvm-targets This improves some tests that previously failed with: ghc: panic! (the 'impossible' happened) GHC version 9.3.20211211: Failed to lookup LLVM data layout Target: x86_64-unknown-openbsd Added the new generated lines to `llvm-targets` on an openbsd 7.0-current with clang 11.1.0. - - - - - 45bd6308 by Joachim Breitner at 2021-12-14T20:56:18-05:00 Test case from #19313 - - - - - f5a0b408 by Andrei Barbu at 2021-12-15T16:33:17-05:00 Plugin load order should follow the commandline order (fixes #17884) In the past the order was reversed because flags are consed onto a list. No particular behavior was documented. We now reverse the flags and document the behavior. - - - - - d13b9f20 by Cheng Shao at 2021-12-15T16:33:54-05:00 base: use `CUIntPtr` instead of `Ptr ()` as the autoconf detected Haskell type for C pointers When autoconf detects a C pointer type, we used to specify `Ptr ()` as the Haskell type. This doesn't work in some cases, e.g. in `wasi-libc`, `clockid_t` is a pointer type, but we expected `CClockId` to be an integral type, and `Ptr ()` lacks various integral type instances. - - - - - 89c1ffd6 by Cheng Shao at 2021-12-15T16:33:54-05:00 base: fix autoconf detection of C pointer types We used to attempt compiling `foo_t val; *val;` to determine if `foo_t` is a pointer type in C. This doesn't work if `foo_t` points to an incomplete type, and autoconf will detect `foo_t` as a floating point type in that case. Now we use `memset(val, 0, 0)` instead, and it works for incomplete types as well. - - - - - 6cea7311 by Cheng Shao at 2021-12-15T16:33:54-05:00 Add a note to base changelog - - - - - 3c3e5c03 by Ben Gamari at 2021-12-17T21:20:57-05:00 Regression test for renamer/typechecker performance (#20261) We use the parser generated by stack to ensure reproducibility - - - - - 5d5620bc by Krzysztof Gogolewski at 2021-12-17T21:21:32-05:00 Change isUnliftedTyCon to marshalablePrimTyCon (#20401) isUnliftedTyCon was used in three places: Ticky, Template Haskell and FFI checks. It was straightforward to remove it from Ticky and Template Haskell. It is now used in FFI only and renamed to marshalablePrimTyCon. Previously, it was fetching information from a field in PrimTyCon called is_unlifted. Instead, I've changed the code to compute liftedness based on the kind. isFFITy and legalFFITyCon are removed. They were only referred from an old comment that I removed. There were three functions to define a PrimTyCon, but the only difference was that they were setting is_unlifted to True or False. Everything is now done in mkPrimTyCon. I also added missing integer types in Ticky.hs, I think it was an oversight. Fixes #20401 - - - - - 9d77976d by Matthew Pickering at 2021-12-17T21:22:08-05:00 testsuite: Format metric results with comma separator As noted in #20763 the way the stats were printed was quite hard for a human to compare. Therefore we now insert the comma separator so that they are easier to compare at a glance. Before: ``` Baseline Test Metric value New value Change ----------------------------------------------------------------------------- Conversions(normal) run/alloc 107088.0 107088.0 +0.0% DeriveNull(normal) run/alloc 112050656.0 112050656.0 +0.0% InlineArrayAlloc(normal) run/alloc 1600040712.0 1600040712.0 +0.0% InlineByteArrayAlloc(normal) run/alloc 1440040712.0 1440040712.0 +0.0% InlineCloneArrayAlloc(normal) run/alloc 1600040872.0 1600040872.0 +0.0% MethSharing(normal) run/alloc 480097864.0 480097864.0 +0.0% T10359(normal) run/alloc 354344.0 354344.0 +0.0% ``` After ``` Baseline Test Metric value New value Change ---------------------------------------------------------------------------------- Conversions(normal) run/alloc 107,088 107,088 +0.0% DeriveNull(normal) run/alloc 112,050,656 112,050,656 +0.0% InlineArrayAlloc(normal) run/alloc 1,600,040,712 1,600,040,712 +0.0% InlineByteArrayAlloc(normal) run/alloc 1,440,040,712 1,440,040,712 +0.0% InlineCloneArrayAlloc(normal) run/alloc 1,600,040,872 1,600,040,872 +0.0% MethSharing(normal) run/alloc 480,097,864 480,097,864 +0.0% T10359(normal) run/alloc 354,344 354,344 +0.0% ``` Closes #20763 - - - - - 3f31bfe8 by Sylvain Henry at 2021-12-17T21:22:48-05:00 Perf: inline exprIsCheapX Allow specialization for the ok_app predicate. Perf improvements: Baseline Test Metric value New value Change ----------------------------------------------------------------------------- ManyAlternatives(normal) ghc/alloc 747317244.0 746444024.0 -0.1% ManyConstructors(normal) ghc/alloc 4005046448.0 4001548792.0 -0.1% MultiLayerModules(normal) ghc/alloc 3063361000.0 3063178472.0 -0.0% MultiLayerModulesRecomp(normal) ghc/alloc 894208428.0 894252496.0 +0.0% PmSeriesG(normal) ghc/alloc 48021692.0 47901592.0 -0.3% PmSeriesS(normal) ghc/alloc 61322504.0 61149008.0 -0.3% PmSeriesT(normal) ghc/alloc 90879364.0 90609048.0 -0.3% PmSeriesV(normal) ghc/alloc 60155376.0 59983632.0 -0.3% T10421(normal) ghc/alloc 112820720.0 112517208.0 -0.3% T10421a(normal) ghc/alloc 78783696.0 78557896.0 -0.3% T10547(normal) ghc/alloc 28331984.0 28354160.0 +0.1% T10858(normal) ghc/alloc 180715296.0 180226720.0 -0.3% T11195(normal) ghc/alloc 284139184.0 283981048.0 -0.1% T11276(normal) ghc/alloc 137830804.0 137688912.0 -0.1% T11303b(normal) ghc/alloc 44080856.0 43956152.0 -0.3% T11374(normal) ghc/alloc 249319644.0 249059288.0 -0.1% T11545(normal) ghc/alloc 971507488.0 971146136.0 -0.0% T11822(normal) ghc/alloc 131410208.0 131269664.0 -0.1% T12150(optasm) ghc/alloc 78866860.0 78762296.0 -0.1% T12227(normal) ghc/alloc 494467900.0 494138112.0 -0.1% T12234(optasm) ghc/alloc 56781044.0 56588256.0 -0.3% T12425(optasm) ghc/alloc 90462264.0 90240272.0 -0.2% T12545(normal) ghc/alloc 1694316588.0 1694128448.0 -0.0% T12707(normal) ghc/alloc 955665168.0 955005336.0 -0.1% T13035(normal) ghc/alloc 101875160.0 101713312.0 -0.2% T13056(optasm) ghc/alloc 366370168.0 365347632.0 -0.3% T13253(normal) ghc/alloc 333741472.0 332612920.0 -0.3% T13253-spj(normal) ghc/alloc 124947560.0 124427552.0 -0.4% T13379(normal) ghc/alloc 358997996.0 358879840.0 -0.0% T13701(normal) ghc/alloc 2400391456.0 2399956840.0 -0.0% T13719(normal) ghc/alloc 4193179228.0 4192476392.0 -0.0% T14052(ghci) ghc/alloc 2734741552.0 2735731808.0 +0.0% T14052Type(ghci) ghc/alloc 7323235724.0 7323042264.0 -0.0% T14683(normal) ghc/alloc 2990457260.0 2988899144.0 -0.1% T14697(normal) ghc/alloc 363606476.0 363452952.0 -0.0% T15164(normal) ghc/alloc 1291321780.0 1289491968.0 -0.1% T15304(normal) ghc/alloc 1277838020.0 1276208304.0 -0.1% T15630(normal) ghc/alloc 161074632.0 160388136.0 -0.4% T16190(normal) ghc/alloc 276567192.0 276235216.0 -0.1% T16577(normal) ghc/alloc 7564318656.0 7535598656.0 -0.4% T16875(normal) ghc/alloc 34867720.0 34752440.0 -0.3% T17096(normal) ghc/alloc 288477360.0 288156960.0 -0.1% T17516(normal) ghc/alloc 1712777224.0 1704655496.0 -0.5% T17836(normal) ghc/alloc 1092127336.0 1091709880.0 -0.0% T17836b(normal) ghc/alloc 52083516.0 51954056.0 -0.2% T17977(normal) ghc/alloc 44552228.0 44425448.0 -0.3% T17977b(normal) ghc/alloc 40540252.0 40416856.0 -0.3% T18140(normal) ghc/alloc 81908200.0 81678928.0 -0.3% T18223(normal) ghc/alloc 1166459176.0 1164418104.0 -0.2% T18282(normal) ghc/alloc 131123648.0 130740432.0 -0.3% T18304(normal) ghc/alloc 86486796.0 86223088.0 -0.3% T18478(normal) ghc/alloc 746029440.0 745619968.0 -0.1% T18698a(normal) ghc/alloc 337037580.0 336533824.0 -0.1% T18698b(normal) ghc/alloc 398324600.0 397696400.0 -0.2% T18923(normal) ghc/alloc 68496432.0 68286264.0 -0.3% T1969(normal) ghc/alloc 760424696.0 759641664.0 -0.1% T19695(normal) ghc/alloc 1421672472.0 1413682104.0 -0.6% T20049(normal) ghc/alloc 88601524.0 88336560.0 -0.3% T3064(normal) ghc/alloc 190808832.0 190659328.0 -0.1% T3294(normal) ghc/alloc 1604483120.0 1604339080.0 -0.0% T4801(normal) ghc/alloc 296501624.0 296388448.0 -0.0% T5030(normal) ghc/alloc 364336308.0 364206240.0 -0.0% T5321FD(normal) ghc/alloc 270688492.0 270386832.0 -0.1% T5321Fun(normal) ghc/alloc 300860396.0 300559200.0 -0.1% T5631(normal) ghc/alloc 575822760.0 575579160.0 -0.0% T5642(normal) ghc/alloc 470243356.0 468988784.0 -0.3% T5837(normal) ghc/alloc 35936468.0 35821360.0 -0.3% T6048(optasm) ghc/alloc 102587024.0 102222000.0 -0.4% T783(normal) ghc/alloc 386539204.0 386003344.0 -0.1% T9020(optasm) ghc/alloc 247435312.0 247324184.0 -0.0% T9198(normal) ghc/alloc 47170036.0 47054840.0 -0.2% T9233(normal) ghc/alloc 677186820.0 676550032.0 -0.1% T9630(normal) ghc/alloc 1456411516.0 1451045736.0 -0.4% T9675(optasm) ghc/alloc 427190224.0 426812568.0 -0.1% T9872a(normal) ghc/alloc 1704660040.0 1704681856.0 +0.0% T9872b(normal) ghc/alloc 2180109488.0 2180130856.0 +0.0% T9872c(normal) ghc/alloc 1760209640.0 1760231456.0 +0.0% T9872d(normal) ghc/alloc 501126052.0 500973488.0 -0.0% T9961(normal) ghc/alloc 353244688.0 353063104.0 -0.1% TcPlugin_RewritePerf(normal) ghc/alloc 2387276808.0 2387254168.0 -0.0% WWRec(normal) ghc/alloc 588651140.0 587684704.0 -0.2% hard_hole_fits(normal) ghc/alloc 492063812.0 491798360.0 -0.1% hie002(normal) ghc/alloc 9334355960.0 9334396872.0 +0.0% parsing001(normal) ghc/alloc 537410584.0 537421736.0 +0.0% geo. mean -0.2% - - - - - e04878b0 by Matthew Pickering at 2021-12-17T21:23:23-05:00 ci: Use correct metrics baseline It turns out there was already a function in the CI script to correctly set the baseline for performance tests but it was just never called. I now call it during the initialisation to set the correct baseline. I also made the make testsuite driver take into account the PERF_BASELINE_COMMIT environment variable Fixes #20811 - - - - - 1327c176 by Matthew Pickering at 2021-12-17T21:23:58-05:00 Add regression test for T20189 Closes #20189 - - - - - fc9b1755 by Matthew Pickering at 2021-12-17T21:24:33-05:00 Fix documentation formatting in Language.Haskell.TH.CodeDo Fixes #20543 - - - - - abef93f3 by Matthew Pickering at 2021-12-17T21:24:33-05:00 Expand documentation for MulArrowT constructor Fixes #20812 - - - - - 94c3ff66 by Cheng Shao at 2021-12-17T21:25:09-05:00 Binary: make withBinBuffer safe With this patch, withBinBuffer will construct a ByteString that properly captures the reference to the BinHandle internal MutableByteArray#, making it safe to convert a BinHandle to ByteString and use that ByteString outside the continuation. - - - - - a3552934 by Sebastian Graf at 2021-12-17T21:25:45-05:00 Demand: `Eq DmdType` modulo `defaultFvDmd` (#20827) Fixes #20827 by filtering out any default free variable demands (as per `defaultFvDmd`) prior to comparing the assocs of the `DmdEnv`. The details are in `Note [Demand type Equality]`. - - - - - 9529d859 by Sylvain Henry at 2021-12-17T21:26:24-05:00 Perf: avoid using (replicateM . length) when possible Extracted from !6622 - - - - - 887d8b4c by Matthew Pickering at 2021-12-17T21:26:59-05:00 testsuite: Ensure that -dcore-lint is not set for compiler performance tests This place ensures that the default -dcore-lint option is disabled by default when collect_compiler_stats is used but you can still pass -dcore-lint as an additional option (see T1969 which tests core lint performance). Fixes #20830 ------------------------- Metric Decrease: PmSeriesS PmSeriesT PmSeriesV T10858 T11195 T11276 T11374 T11822 T14052 T14052Type T17096 T17836 T17836b T18478 T18698a T18698b ------------------------- - - - - - 5ff47ff5 by Ben Gamari at 2021-12-21T01:46:00-05:00 codeGen: Introduce flag to bounds-check array accesses Here we introduce code generator support for instrument array primops with bounds checking, enabled with the `-fcheck-prim-bounds` flag. Introduced to debug #20769. - - - - - d47bb109 by Ben Gamari at 2021-12-21T01:46:00-05:00 rts: Add optional bounds checking in out-of-line primops - - - - - 8ea79a16 by Ben Gamari at 2021-12-21T01:46:00-05:00 Rename -fcatch-bottoms to -fcatch-nonexhaustive-cases As noted in #20601, the previous name was rather misleading. - - - - - 00b55bfc by Ben Gamari at 2021-12-21T01:46:00-05:00 Introduce -dlint flag As suggested in #20601, this is a short-hand for enabling the usual GHC-internal sanity checks one typically leans on when debugging runtime crashes. - - - - - 9728d6c2 by Sylvain Henry at 2021-12-21T01:46:39-05:00 Give plugins a better interface (#17957) Plugins were directly fetched from HscEnv (hsc_static_plugins and hsc_plugins). The tight coupling of plugins and of HscEnv is undesirable and it's better to store them in a new Plugins datatype and to use it in the plugins' API (e.g. withPlugins, mapPlugins...). In the process, the interactive context (used by GHCi) got proper support for different static plugins than those used for loaded modules. Bump haddock submodule - - - - - 9bc5ab64 by Greg Steuck at 2021-12-21T01:47:17-05:00 Use libc++ instead of libstdc++ on openbsd in addition to freebsd This is not entirely accurate because some openbsd architectures use gcc. Yet we don't have ghc ported to them and thus the approximation is good enough. Fixes ghcilink006 test - - - - - f92c9c0d by Greg Steuck at 2021-12-21T01:47:55-05:00 Only use -ldl conditionally to fix T3807 OpenBSD doesn't have this library and so the linker complains: ld.lld: error: unable to find library -ldl - - - - - ff657a81 by Greg Steuck at 2021-12-21T01:48:32-05:00 Mark `linkwhole` test as expected broken on OpenBSD per #20841 - - - - - 1a596d06 by doyougnu at 2021-12-22T00:12:27-05:00 Cmm: DynFlags to CmmConfig refactor add files GHC.Cmm.Config, GHC.Driver.Config.Cmm Cmm: DynFlag references --> CmmConfig Cmm.Pipeline: reorder imports, add handshake Cmm: DynFlag references --> CmmConfig Cmm.Pipeline: DynFlag references --> CmmConfig Cmm.LayoutStack: DynFlag references -> CmmConfig Cmm.Info.Build: DynFlag references -> CmmConfig Cmm.Config: use profile to retrieve platform Cmm.CLabel: unpack NCGConfig in labelDynamic Cmm.Config: reduce CmmConfig surface area Cmm.Config: add cmmDoCmmSwitchPlans field Cmm.Config: correct cmmDoCmmSwitchPlans flag The original implementation dispatches work in cmmImplementSwitchPlans in an `otherwise` branch, hence we must add a not to correctly dispatch Cmm.Config: add cmmSplitProcPoints simplify Config remove cmmBackend, and cmmPosInd Cmm.CmmToAsm: move ncgLabelDynamic to CmmToAsm Cmm.CLabel: remove cmmLabelDynamic function Cmm.Config: rename cmmOptDoLinting -> cmmDoLinting testsuite: update CountDepsAst CountDepsParser - - - - - d7cc8f19 by Matthew Pickering at 2021-12-22T00:13:02-05:00 ci: Fix master CI I made a mistake in the bash script so there were errors about "$CI_MERGE_REQUEST_DIFF_BASE_SHA" not existing. - - - - - 09b6cb45 by Alan Zimmerman at 2021-12-22T00:13:38-05:00 Fix panic trying to -ddump-parsed-ast for implicit fixity A declaration such as infixr ++++ is supplied with an implicit fixity of 9 in the parser, but uses an invalid SrcSpan to capture this. Use of this span triggers a panic. Fix the problem by not recording an exact print annotation for the non-existent fixity source. Closes #20846 - - - - - 3ed90911 by Matthew Pickering at 2021-12-22T14:47:40-05:00 testsuite: Remove reqlib modifier The reqlib modifer was supposed to indicate that a test needed a certain library in order to work. If the library happened to be installed then the test would run as normal. However, CI has never run these tests as the packages have not been installed and we don't want out tests to depend on things which might get externally broken by updating the compiler. The new strategy is to run these tests in head.hackage, where the tests have been cabalised as well as possible. Some tests couldn't be transferred into the normal style testsuite but it's better than never running any of the reqlib tests. https://gitlab.haskell.org/ghc/head.hackage/-/merge_requests/169 A few submodules also had reqlib tests and have been updated to remove it. Closes #16264 #20032 #17764 #16561 - - - - - ac3e8c52 by Matthew Pickering at 2021-12-22T14:48:16-05:00 perf ci: Start searching form the performance baseline If you specify PERF_BASELINE_COMMIT then this can fail if the specific commit you selected didn't have perf test metrics. (This can happen in CI for example if a build fails on master). Therefore instead of just reporting all tests as new, we start searching downwards from this point to try and find a good commit to report numbers from. - - - - - 9552781a by Matthew Pickering at 2021-12-22T14:48:51-05:00 Mark T16525b as fragile on windows See ticket #20852 - - - - - 13a6d85a by Andreas Klebinger at 2021-12-23T10:55:36-05:00 Make callerCC profiling mode represent entry counter flag. Fixes #20854 - - - - - 80daefce by Matthew Pickering at 2021-12-23T10:56:11-05:00 Properly filter for module visibility in resolvePackageImport This completes the fix for #20779 / !7123. Beforehand, the program worked by accident because the two versions of the library happened to be ordered properly (due to how the hashes were computed). In the real world I observed them being the other way around which meant the final lookup failed because we weren't filtering for visibility. I modified the test so that it failed (and it's fixed by this patch). - - - - - e6191d39 by Krzysztof Gogolewski at 2021-12-25T18:26:44+01:00 Fix typos - - - - - 3219610e by Greg Steuck at 2021-12-26T22:12:43-05:00 Use POSIX-compliant egrep expression to fix T8832 on OpenBSD - - - - - fd42ab5f by Matthew Pickering at 2021-12-28T09:47:53+00:00 Multiple Home Units Multiple home units allows you to load different packages which may depend on each other into one GHC session. This will allow both GHCi and HLS to support multi component projects more naturally. Public Interface ~~~~~~~~~~~~~~~~ In order to specify multiple units, the -unit @⟨filename⟩ flag is given multiple times with a response file containing the arguments for each unit. The response file contains a newline separated list of arguments. ``` ghc -unit @unitLibCore -unit @unitLib ``` where the `unitLibCore` response file contains the normal arguments that cabal would pass to `--make` mode. ``` -this-unit-id lib-core-0.1.0.0 -i -isrc LibCore.Utils LibCore.Types ``` The response file for lib, can specify a dependency on lib-core, so then modules in lib can use modules from lib-core. ``` -this-unit-id lib-0.1.0.0 -package-id lib-core-0.1.0.0 -i -isrc Lib.Parse Lib.Render ``` Then when the compiler starts in --make mode it will compile both units lib and lib-core. There is also very basic support for multiple home units in GHCi, at the moment you can start a GHCi session with multiple units but only the :reload is supported. Most commands in GHCi assume a single home unit, and so it is additional work to work out how to modify the interface to support multiple loaded home units. Options used when working with Multiple Home Units There are a few extra flags which have been introduced specifically for working with multiple home units. The flags allow a home unit to pretend it’s more like an installed package, for example, specifying the package name, module visibility and reexported modules. -working-dir ⟨dir⟩ It is common to assume that a package is compiled in the directory where its cabal file resides. Thus, all paths used in the compiler are assumed to be relative to this directory. When there are multiple home units the compiler is often not operating in the standard directory and instead where the cabal.project file is located. In this case the -working-dir option can be passed which specifies the path from the current directory to the directory the unit assumes to be it’s root, normally the directory which contains the cabal file. When the flag is passed, any relative paths used by the compiler are offset by the working directory. Notably this includes -i and -I⟨dir⟩ flags. -this-package-name ⟨name⟩ This flag papers over the awkward interaction of the PackageImports and multiple home units. When using PackageImports you can specify the name of the package in an import to disambiguate between modules which appear in multiple packages with the same name. This flag allows a home unit to be given a package name so that you can also disambiguate between multiple home units which provide modules with the same name. -hidden-module ⟨module name⟩ This flag can be supplied multiple times in order to specify which modules in a home unit should not be visible outside of the unit it belongs to. The main use of this flag is to be able to recreate the difference between an exposed and hidden module for installed packages. -reexported-module ⟨module name⟩ This flag can be supplied multiple times in order to specify which modules are not defined in a unit but should be reexported. The effect is that other units will see this module as if it was defined in this unit. The use of this flag is to be able to replicate the reexported modules feature of packages with multiple home units. Offsetting Paths in Template Haskell splices ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When using Template Haskell to embed files into your program, traditionally the paths have been interpreted relative to the directory where the .cabal file resides. This causes problems for multiple home units as we are compiling many different libraries at once which have .cabal files in different directories. For this purpose we have introduced a way to query the value of the -working-dir flag to the Template Haskell API. By using this function we can implement a makeRelativeToProject function which offsets a path which is relative to the original project root by the value of -working-dir. ``` import Language.Haskell.TH.Syntax ( makeRelativeToProject ) foo = $(makeRelativeToProject "./relative/path" >>= embedFile) ``` > If you write a relative path in a Template Haskell splice you should use the makeRelativeToProject function so that your library works correctly with multiple home units. A similar function already exists in the file-embed library. The function in template-haskell implements this function in a more robust manner by honouring the -working-dir flag rather than searching the file system. Closure Property for Home Units ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For tools or libraries using the API there is one very important closure property which must be adhered to: > Any dependency which is not a home unit must not (transitively) depend on a home unit. For example, if you have three packages p, q and r, then if p depends on q which depends on r then it is illegal to load both p and r as home units but not q, because q is a dependency of the home unit p which depends on another home unit r. If you are using GHC by the command line then this property is checked, but if you are using the API then you need to check this property yourself. If you get it wrong you will probably get some very confusing errors about overlapping instances. Limitations of Multiple Home Units ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ There are a few limitations of the initial implementation which will be smoothed out on user demand. * Package thinning/renaming syntax is not supported * More complicated reexports/renaming are not yet supported. * It’s more common to run into existing linker bugs when loading a large number of packages in a session (for example #20674, #20689) * Backpack is not yet supported when using multiple home units. * Dependency chasing can be quite slow with a large number of modules and packages. * Loading wired-in packages as home units is currently not supported (this only really affects GHC developers attempting to load template-haskell). * Barely any normal GHCi features are supported, it would be good to support enough for ghcid to work correctly. Despite these limitations, the implementation works already for nearly all packages. It has been testing on large dependency closures, including the whole of head.hackage which is a total of 4784 modules from 452 packages. Internal Changes ~~~~~~~~~~~~~~~~ * The biggest change is that the HomePackageTable is replaced with the HomeUnitGraph. The HomeUnitGraph is a map from UnitId to HomeUnitEnv, which contains information specific to each home unit. * The HomeUnitEnv contains: - A unit state, each home unit can have different package db flags - A set of dynflags, each home unit can have different flags - A HomePackageTable * LinkNode: A new node type is added to the ModuleGraph, this is used to place the linking step into the build plan so linking can proceed in parralel with other packages being built. * New invariant: Dependencies of a ModuleGraphNode can be completely determined by looking at the value of the node. In order to achieve this, downsweep now performs a more complete job of downsweeping and then the dependenices are recorded forever in the node rather than being computed again from the ModSummary. * Some transitive module calculations are rewritten to use the ModuleGraph which is more efficient. * There is always an active home unit, which simplifies modifying a lot of the existing API code which is unit agnostic (for example, in the driver). The road may be bumpy for a little while after this change but the basics are well-tested. One small metric increase, which we accept and also submodule update to haddock which removes ExtendedModSummary. Closes #10827 ------------------------- Metric Increase: MultiLayerModules ------------------------- Co-authored-by: Fendor <power.walross at gmail.com> - - - - - 72824c63 by Richard Eisenberg at 2021-12-28T10:09:28-05:00 Skip computing superclass origins for equalities This yields a small, but measurable, performance improvement. - - - - - 8b6aafb2 by Matthew Pickering at 2021-12-29T14:09:47-05:00 Cabal: Update submodule Closes #20874 - - - - - 44a5507f by Peter Trommler at 2021-12-29T14:10:22-05:00 RTS: Fix CloneStack.c when no table next to code Function `lookupIPE` does not modify its argument. Reflect this in the type. Module `CloneStack.c` relies on this for RTS without tables next to code. Fixes #20879 - - - - - 246d2782 by sheaf at 2022-01-02T04:20:09-05:00 User's guide: newtype decls can use GADTSyntax The user's guide failed to explicitly mention that GADTSyntax can be used to declare newtypes, so we add an example and a couple of explanations. Also explains that `-XGADTs` generalises `-XExistentialQuantification`. Fixes #20848 and #20865. - - - - - f212cece by Hécate Moonlight at 2022-01-02T04:20:47-05:00 Add a source-repository stanza to rts/rts.cabal - - - - - d9e49195 by Greg Steuck at 2022-01-03T05:18:24+00:00 Replace `seq` with POSIX-standard printf(1) in ManyAlternatives test The test now passes on OpenBSD instead of generating broken source which was rejected by GHC with ManyAlternatives.hs:5:1: error: The type signature for ‘f’ lacks an accompanying binding - - - - - 80e416ae by Greg Steuck at 2022-01-03T05:18:24+00:00 Replace `seq` with POSIX-standard in PmSeriesG test - - - - - 8fa52f5c by Eric Lindblad at 2022-01-03T16:48:51-05:00 fix typo - - - - - a49f5889 by Roland Senn at 2022-01-03T16:49:29-05:00 Add regressiontest for #18045 Issue #18045 got fixed by !6971. - - - - - 7f10686e by sheaf at 2022-01-03T16:50:07-05:00 Add test for #20894 - - - - - 5111028e by sheaf at 2022-01-04T19:56:13-05:00 Check quoted TH names are in the correct namespace When quoting (using a TH single or double quote) a built-in name such as the list constructor (:), we didn't always check that the resulting 'Name' was in the correct namespace. This patch adds a check in GHC.Rename.Splice to ensure we get a Name that is in the term-level/type-level namespace, when using a single/double tick, respectively. Fixes #20884. - - - - - 1de94daa by George Thomas at 2022-01-04T19:56:51-05:00 Fix Haddock parse error in GHC.Exts.Heap.FFIClosures.hs - - - - - e59bd46a by nineonine at 2022-01-05T18:07:18+00:00 Add regression test (#13997) - - - - - c080b443 by Sylvain Henry at 2022-01-06T02:24:54-05:00 Perf: use SmallArray for primops' Ids cache (#20857) SmallArray doesn't perform bounds check (faster). Make primop tags start at 0 to avoid index arithmetic. - - - - - ec26c38b by Sylvain Henry at 2022-01-06T02:24:54-05:00 Use primOpIds cache more often (#20857) Use primOpId instead of mkPrimOpId in a few places to benefit from Id caching. I had to mess a little bit with the module hierarchy to fix cycles and to avoid adding too many new dependencies to count-deps tests. - - - - - f7fc62e2 by Greg Steuck at 2022-01-06T07:56:22-05:00 Disable T2615 on OpenBSD, close #20869 - - - - - 978ea35e by Greg Steuck at 2022-01-06T07:57:00-05:00 Change ulimit -n in openFile008 back to 1024 The test only wants 1000 descriptors, so changing the limit to double that *in the context of just this test* makes no sense. This is a manual revert of 8f7194fae23bdc6db72fc5784933f50310ce51f9. The justification given in the description doesn't instill confidence. As of HEAD, the test fails on OpenBSD where ulimit -n is hard-limited to 1024. The test suite attempts to change it to 2048, which fails. The test proceeds with the unchanged default of 512 and naturally the test program fails due to the low ulimit. The fixed test now passes. - - - - - 7b783c9d by Matthew Pickering at 2022-01-07T18:25:06-05:00 Thoughtful forcing in CoreUnfolding We noticed that the structure of CoreUnfolding could leave double the amount of CoreExprs which were retained in the situation where the template but not all the predicates were forced. This observation was then confirmed using ghc-debug: ``` (["ghc:GHC.Core:App","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 237) (["ghc:GHC.Core:App","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","ghc-prim:GHC.Types:True"],Count 1) (["ghc:GHC.Core:Case","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 12) (["ghc:GHC.Core:Cast","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","BLACKHOLE"],Count 1) (["ghc:GHC.Core:Cast","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 78) (["ghc:GHC.Core:Cast","ghc-prim:GHC.Types:True","THUNK_1_0","ghc-prim:GHC.Types:False","THUNK_1_0"],Count 1) (["ghc:GHC.Core:Cast","ghc-prim:GHC.Types:True","ghc-prim:GHC.Types:False","THUNK_1_0","THUNK_1_0"],Count 3) (["ghc:GHC.Core:Cast","ghc-prim:GHC.Types:True","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0"],Count 1) (["ghc:GHC.Core:Lam","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","BLACKHOLE"],Count 31) (["ghc:GHC.Core:Lam","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 4307) (["ghc:GHC.Core:Lam","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","ghc-prim:GHC.Types:True"],Count 6) (["ghc:GHC.Core:Let","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 29) (["ghc:GHC.Core:Lit","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","ghc-prim:GHC.Types:True"],Count 1) (["ghc:GHC.Core:Tick","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 36) (["ghc:GHC.Core:Var","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 1) (["ghc:GHC.Core:Var","ghc-prim:GHC.Types:True","ghc-prim:GHC.Types:False","THUNK_1_0","THUNK_1_0"],Count 6) (["ghc:GHC.Core:Var","ghc-prim:GHC.Types:True","ghc-prim:GHC.Types:False","ghc-prim:GHC.Types:True","THUNK_1_0"],Count 2) ``` Where we can see that the first argument is forced but there are still thunks remaining which retain the old expr. For my test case (a very big module, peak of 3 000 000 core terms) this reduced peak memory usage by 1G (12G -> 11G). Fixes #20905 - - - - - f583eb8e by Joachim Breitner at 2022-01-07T18:25:41-05:00 Remove dangling references to Note [Type-checking overloaded labels] that note was removed in 4196969c53c55191e644d9eb258c14c2bc8467da - - - - - 2b6c2179 by Matthew Pickering at 2022-01-11T19:37:45-05:00 hadrian: Add bootstrap scripts for building without cabal-install These scripts are originally from the cabal-install repo with a few small tweaks. This utility allows you to build hadrian without cabal-install, which can be useful for packagers. If you are a developer then build hadrian using cabal-install. If you want to bootstrap with ghc-8.10.5 then run the ./bootstrap script with the `plan-bootstrap-8.10.5.json` file. bootstrap.py -d plan-bootstrap-8.10.5.json -w /path/to-ghc The result of the bootstrap script will be a hadrian binary in `_build/bin/hadrian`. There is a script (using nix) which can be used to generate the bootstrap plans for the range of supported GHC versions using nix. generate_bootstrap_plans Otherwise you can run the commands in ./generate_bootstrap_plans directly. Fixes #17103 - - - - - a8fb4251 by Zubin Duggal at 2022-01-11T19:37:45-05:00 hadrian: allow offline bootstrapping This patch adds the ability to fetch and store dependencies needed for boostrapping hadrian. By default the script will download the dependencies from the network but some package managers disallow network access so there are also options to build given a supplied tarball. The -s option allos you to provide the tarball bootstrap.py -d plan-bootstrap-8.10.5.json -w /path/to-ghc -s sources-tarball.tar.gz Which dependencies you need can be queried using the `list-sources` option. bootstrap.py list-sources -d plan-bootstrap-8.10.5.json This produces `fetch_plan.json` which tells you where to get each source from. You can instruct the script to create the tarball using the `fetch` option. bootstrap.py fetch -d plan-bootstrap-8.10.5.json -o sources-tarball.tar.gz Together these commands mean you can build GHC without needing cabal-install. Fixes #17103 - - - - - 02cf4bc6 by Zubin Duggal at 2022-01-11T19:37:45-05:00 hadrian: Fully implement source distributions (#19317) We use `git ls-files` to get the list of files to include in the source distribution. Also implements the `-testsuite` and `-extra-tarballs` distributions. - - - - - 85473a09 by Zubin Duggal at 2022-01-11T19:37:45-05:00 ci: test bootstrapping and use hadrian for source dists - - - - - 759f3421 by Matthew Pickering at 2022-01-11T19:38:21-05:00 ci: Nightly, run one head.hackage job with core-lint and one without This fixes serious skew in the performance numbers because the packages were build with core-lint. Fixes #20826 - - - - - 6737c8e1 by Ben Gamari at 2022-01-11T19:38:56-05:00 rts: Depend explicitly on libc As noted in #19029, currently `ghc-prim` explicitly lists `libc` in `extra-libraries`, resulting in incorrect link ordering with the `extra-libraries: pthread` in `libHSrts`. Fix this by adding an explicit dependency on `libc` to `libHSrts`. Closes #19029. - - - - - 247cd336 by Ben Gamari at 2022-01-11T19:39:32-05:00 rts: Only declare environ when necessary Previously we would unconditionally provide a declaration for `environ`, even if `<unistd.h>` already provided one. This would result in `-Werror` builds failing on some platforms. Also `#include <unistd.h>` to ensure that the declaration is visible. Fixes #20861. - - - - - b65e7274 by Greg Steuck at 2022-01-11T19:40:10-05:00 Skip T18623 on OpenBSD The bug it regresses didn't happen on this OS (no RLIMIT_AS) and the regression doesn't work (ulimit: -v: unknown option) - - - - - c6300cb3 by Greg Steuck at 2022-01-11T19:40:50-05:00 Skip T16180 on OpenBSD due to bug #14012 - - - - - addf8e54 by sheaf at 2022-01-11T19:41:28-05:00 Kind TyCons: require KindSignatures, not DataKinds Uses of a TyCon in a kind signature required users to enable DataKinds, which didn't make much sense, e.g. in type U = Type type MyMaybe (a :: U) = MyNothing | MyJust a Now the DataKinds error is restricted to data constructors; the use of kind-level type constructors is instead gated behind -XKindSignatures. This patch also adds a convenience pattern synonym for patching on both a TyCon or a TcTyCon stored in a TcTyThing, used in tcTyVar and tc_infer_id. fixes #20873 - - - - - 34d8bc24 by sheaf at 2022-01-11T19:42:07-05:00 Fix parsing & printing of unboxed sums The pretty-printing of partially applied unboxed sums was incorrect, as we incorrectly dropped the first half of the arguments, even for a partial application such as (# | #) @IntRep @DoubleRep Int# which lead to the nonsensical (# DoubleRep | Int# #). This patch also allows users to write unboxed sum type constructors such as (# | #) :: TYPE r1 -> TYPE r2 -> TYPE (SumRep '[r1,r2]). Fixes #20858 and #20859. - - - - - 49731fed by sheaf at 2022-01-11T19:42:46-05:00 TcPlugins: `newWanted` uses the provided `CtLoc` The `GHC.Tc.Plugin.newWanted` function takes a `CtLoc` as an argument, but it used to discard the location information, keeping only the `CtOrigin`. It would then retrieve the source location from the `TcM` environment using `getCtLocM`. This patch changes this so that `GHC.Tc.Plugin.newWanted` passes on the full `CtLoc`. This means that authors of type-checking plugins no longer need to manually set the `CtLoc` environment in the `TcM` monad if they want to create a new Wanted constraint with the given `CtLoc` (in particular, for setting the `SrcSpan` of an emitted constraint). This makes the `newWanted` function consistent with `newGiven`, which always used the full `CtLoc` instead of using the environment. Fixes #20895 - - - - - 23d215fc by Krzysztof Gogolewski at 2022-01-11T19:43:22-05:00 warnPprTrace: pass separately the reason This makes it more similar to pprTrace, pprPanic etc. - - - - - 833216a3 by Matthew Pickering at 2022-01-11T19:43:57-05:00 Use interactive flags when printing expressions in GHCi The documentation states that the interactive flags should be use for any interactive expressions. The interactive flags are used when typechecking these expressions but not when printing. The session flags (modified by :set) are only used when loading a module. Fixes #20909 - - - - - 19b13698 by Matthew Pickering at 2022-01-11T19:43:57-05:00 Enable :seti in a multi component repl Part of #20889 - - - - - 7ca43a3f by Matthew Pickering at 2022-01-11T19:44:33-05:00 Change assertions in Stats.c to warnings (and introduce WARN macro) ASSERT should be used in situations where something very bad will happen later on if a certain invariant doesn't hold. The idea is that IF we catch the assertion earlier then it will be easier to work out what's going on at that point rather than at some indeterminate point in the future of the program. The assertions in Stats.c do not obey this philsophy and it is quite annoying if you are running a debug build (or a ticky compiler) and one of these assertions fails right at the end of your program, before the ticky report is printed out so you don't get any profiling information. Given that nothing terrible happens if these assertions are not true, or at least the terrible thing will happen in very close proximity to the assertion failure, these assertions use the new WARN macro which prints the assertion failure to stdout but does not exit the program. Of course, it would be better to fix these metrics to not trigger the assertion in the first place but if they did fail again in the future it is frustrating to be bamboozled in this manner. Fixes #20899 - - - - - e505dbd3 by Greg Steuck at 2022-01-11T19:45:11-05:00 Remove from error the parenthesized amount of memory requested Diagnostics for outofmem test on OpenBSD includes the amount of memory that it failed to allocate. This seems like an irrelevant detail that could change over time and isn't required for determining if test passed. Typical elided text is '(requested 2148532224 bytes)' - - - - - 7911aaa9 by Greg Steuck at 2022-01-11T19:45:50-05:00 Feed /dev/null into cgrun025 The test currently times out waiting for end of stdin in getContents. The expected output indicates that nothing should come for the test to pass as written. It is unclear how the test was supposed to pass, but this looks like a sufficient hack to make it work. - - - - - ed39d15c by Greg Steuck at 2022-01-11T19:46:28-05:00 Disable keep-cafs{,-fail} tests on OpenBSD They are likely broken for the same reason as FreeBSD where the tests are already disabled. - - - - - 35bea01b by Peter Trommler at 2022-01-11T19:47:04-05:00 RTS: Remove unused file xxhash.c - - - - - c2099059 by Matthew Pickering at 2022-01-11T19:47:39-05:00 RTTI: Substitute the [rk] skolems into kinds (Fixes #10616 and #10617) Co-authored-by: Roland Senn <rsx at bluewin.ch> - - - - - 92f3e6e4 by Matthew Pickering at 2022-01-11T19:48:15-05:00 docs: MonadComprehension desugar using Alternative rather than MonadPlus Fixes #20928 - - - - - 7b0c9384 by Sylvain Henry at 2022-01-12T23:25:49-05:00 Abstract BangOpts Avoid requiring to pass DynFlags to mkDataConRep/buildDataCon. When we load an interface file, these functions don't use the flags. This is preliminary work to decouple the loader from the type-checker for #14335. - - - - - a31ace56 by Sylvain Henry at 2022-01-12T23:25:49-05:00 Untangled GHC.Types.Id.Make from the driver - - - - - 81a8f7a7 by Zubin Duggal at 2022-01-12T23:26:24-05:00 testsuite: Fix import on python 3.10 - - - - - 66831b94 by Ben Gamari at 2022-01-13T14:50:13-05:00 hadrian: Include bash completion script in bindist See #20802. - - - - - be33d61a by Sebastian Graf at 2022-01-13T14:50:49-05:00 release notes: Changes to CPR analysis - - - - - c2a6c3eb by Sebastian Graf at 2022-01-13T14:50:49-05:00 release notes: Changes to Demand analysis - - - - - 9ccc445a by Eric Lindblad at 2022-01-14T10:35:46-05:00 add NUMJOBS - - - - - 564b89ae by Eric Lindblad at 2022-01-14T10:35:46-05:00 Revert "add NUMJOBS" This reverts commit c0b854e929f82c680530e944e12fad24f9e14f8e - - - - - 2dfc268c by Eric Lindblad at 2022-01-14T10:35:46-05:00 update URLs - - - - - 1aace894 by Eric Lindblad at 2022-01-14T10:35:46-05:00 reinsert target - - - - - 52a4f5ab by Andreas Klebinger at 2022-01-14T10:36:21-05:00 Add test for #20938. - - - - - e2b60be8 by Ben Gamari at 2022-01-15T03:41:16-05:00 rts: Consolidate RtsSymbols from libc Previously (9ebda74ec5331911881d734b21fbb31c00a0a22f) `environ` was added to `RtsSymbols` to ensure that environment was correctly propagated when statically linking. However, this introduced #20577 since platforms are inconsistent in whether they provide a prototype for `environ`. I fixed this by providing a prototype but while doing so dropped symbol-table entry, presumably thinking that it was redundant due to the entry in the mingw-specific table. Here I reintroduce the symbol table entry for `environ` and move libc symbols shared by Windows and Linux into a new macro, `RTS_LIBC_SYMBOLS`, avoiding this potential confusion. - - - - - 0dc72395 by Tamar Christina at 2022-01-15T03:41:55-05:00 winio: fix heap corruption and various leaks. - - - - - 4031ef62 by Eric Lindblad at 2022-01-15T20:11:55+00:00 wikipedia link - - - - - a13aff98 by Eric Lindblad at 2022-01-17T08:25:51-05:00 ms link - - - - - f161e890 by sheaf at 2022-01-17T14:52:50+00:00 Use diagnostic infrastructure in GHC.Tc.Errors - - - - - 18c797b8 by Jens Petersen at 2022-01-18T16:12:14-05:00 hadrian BinaryDist: version ghc in ghciScriptWrapper like we do for the non-Hadrian wrapper script. Otherwise if $bindir/ghc is a different ghc version then versioned ghci will incorrectly run the other ghc version instead. (Normally this would only happen if there are parallel ghc versions installed in bindir.) All the other wrapper scripts already have versioned executablename - - - - - 310424d0 by Matthew Pickering at 2022-01-18T16:12:50-05:00 Correct type of static forms in hsExprType The simplest way to do this seemed to be to persist the whole type in the extension field from the typechecker so that the few relevant places * Desugaring can work out the return type by splitting this type rather than calling `dsExpr` (slightly more efficient). * hsExprType can just return the correct type. * Zonking has to now zonk the type as well The other option we considered was wiring in StaticPtr but that is actually quite tricky because StaticPtr refers to StaticPtrInfo which has field selectors (which we can't easily wire in). Fixes #20150 - - - - - 7ec783de by Matthew Pickering at 2022-01-18T16:12:50-05:00 Add test for using type families with static pointers Issue was reported on #13306 - - - - - 2d205154 by Sebastian Graf at 2022-01-18T16:13:25-05:00 Stricten the Strict State monad I found it weird that most of the combinators weren't actually strict. Making `pure` strict in the state should hopefully give Nested CPR an easier time to unbox the nested state. - - - - - 5a6efd21 by Ben Gamari at 2022-01-18T16:14:01-05:00 rts/winio: Fix #18382 Here we refactor WinIO's IO completion scheme, squashing a memory leak and fixing #18382. To fix #18382 we drop the special thread status introduced for IoPort blocking, BlockedOnIoCompletion, as well as drop the non-threaded RTS's special dead-lock detection logic (which is redundant to the GC's deadlock detection logic), as proposed in #20947. Previously WinIO relied on foreign import ccall "wrapper" to create an adjustor thunk which can be attached to the OVERLAPPED structure passed to the operating system. It would then use foreign import ccall "dynamic" to back out the original continuation from the adjustor. This roundtrip is significantly more expensive than the alternative, using a StablePtr. Furthermore, the implementation let the adjustor leak, meaning that every IO request would leak a page of memory. Fixes T18382. - - - - - 01254ceb by Matthew Pickering at 2022-01-18T16:14:37-05:00 Add note about heap invariant Closed #20904 - - - - - 21510698 by Sergey Vinokurov at 2022-01-18T16:15:12-05:00 Improve detection of lld linker Newer lld versions may include vendor info in --version output and thus the version string may not start with ‘LLD’. Fixes #20907 - - - - - 95e7964b by Peter Trommler at 2022-01-18T20:46:08-05:00 Fix T20638 on big-endian architectures The test reads a 16 bit value from an array of 8 bit values. Naturally, that leads to different values read on big-endian architectures than on little-endian. In this case the value read is 0x8081 on big-endian and 0x8180 on little endian. This patch changes the argument of the `and` machop to mask bit 7 which is the only bit different. The test still checks that bit 15 is zero, which was the original issue in #20638. Fixes #20906. - - - - - fd0019a0 by Eric Lindblad at 2022-01-18T20:46:48-05:00 ms and gh links - - - - - 85dc61ee by Zubin Duggal at 2022-01-18T20:47:23-05:00 ci: Fix subtlety with not taking effect because of time_it (#20898) - - - - - 592e4113 by Anselm Schüler at 2022-01-19T13:31:49-05:00 Note that ImpredicativeTypes doesn’t allow polymorphic instances See #20939 - - - - - 3b009e1a by Ben Gamari at 2022-01-19T13:32:25-05:00 base: Add CTYPE pragmas to all foreign types Fixes #15531 by ensuring that we know the corresponding C type for all marshalling wrappers. Closes #15531. - - - - - 516eeb9e by Robert Hensing at 2022-01-24T21:28:24-05:00 Add -fcompact-unwind This gives users the choice to enable __compact_unwind sections when linking. These were previously hardcoded to be removed. This can be used to solved the problem "C++ does not catch exceptions when used with Haskell-main and linked by ghc", https://gitlab.haskell.org/ghc/ghc/-/issues/11829 It does not change the default behavior, because I can not estimate the impact this would have. When Apple first introduced the compact unwind ABI, a number of open source projects have taken the easy route of disabling it, avoiding errors or even just warnings shortly after its introduction. Since then, about a decade has passed, so it seems quite possible that Apple itself, and presumably many programs with it, have successfully switched to the new format, to the point where the old __eh_frame section support is in disrepair. Perhaps we should get along with the program, but for now we can test the waters with this flag, and use it to fix packages that need it. - - - - - 5262b1e5 by Robert Hensing at 2022-01-24T21:28:24-05:00 Add test case for C++ exception handling - - - - - a5c94092 by Sebastian Graf at 2022-01-24T21:29:00-05:00 Write Note [Strict State monad] to explain what G.U.M.State.Strict does As requested by Simon after review of !7342. I also took liberty to define the `Functor` instance by hand, as the derived one subverts the invariants maintained by the pattern synonym (as already stated in `Note [The one-shot state monad trick]`). - - - - - 9b0d56d3 by Eric Lindblad at 2022-01-24T21:29:38-05:00 links - - - - - 4eac8e72 by Ben Gamari at 2022-01-24T21:30:13-05:00 ghc-heap: Drop mention of BlockedOnIOCompletion Fixes bootstrap with GHC 9.0 after 5a6efd218734dbb5c1350531680cd3f4177690f1 - - - - - 7d7b9a01 by Ryan Scott at 2022-01-24T21:30:49-05:00 Hadrian: update the index-state to allow building with GHC 9.0.2 Fixes #20984. - - - - - aa50e118 by Peter Trommler at 2022-01-24T21:31:25-05:00 testsuite: Mark test that require RTS linker - - - - - 871ce2a3 by Matthew Pickering at 2022-01-25T17:27:30-05:00 ci: Move (most) deb9 jobs to deb10 deb9 is now end-of-life so we are dropping support for producing bindists. - - - - - 9d478d51 by Ryan Scott at 2022-01-25T17:28:06-05:00 DeriveGeneric: look up datacon fixities using getDataConFixityFun Previously, `DeriveGeneric` would look up the fixity of a data constructor using `getFixityEnv`, but this is subtly incorrect for data constructors defined in external modules. This sort of situation can happen with `StandaloneDeriving`, as noticed in #20994. In fact, the same bug has occurred in the past in #9830, and while that bug was fixed for `deriving Read` and `deriving Show`, the fix was never extended to `DeriveGeneric` due to an oversight. This patch corrects that oversight. Fixes #20994. - - - - - 112e9e9e by Zubin Duggal at 2022-01-25T17:28:41-05:00 Fix Werror on alpine - - - - - 781323a3 by Matthew Pickering at 2022-01-25T17:29:17-05:00 Widen T12545 acceptance window This test has been the scourge of contributors for a long time. It has caused many failed CI runs and wasted hours debugging a test which barely does anything. The fact is does nothing is the reason for the flakiness and it's very sensitive to small changes in initialisation costs, in particular adding wired-in things can cause this test to fluctuate quite a bit. Therefore we admit defeat and just bump the threshold up to 10% to catch very large regressions but otherwise don't care what this test does. Fixes #19414 - - - - - e471a680 by sheaf at 2022-01-26T12:01:45-05:00 Levity-polymorphic arrays and mutable variables This patch makes the following types levity-polymorphic in their last argument: - Array# a, SmallArray# a, Weak# b, StablePtr# a, StableName# a - MutableArray# s a, SmallMutableArray# s a, MutVar# s a, TVar# s a, MVar# s a, IOPort# s a The corresponding primops are also made levity-polymorphic, e.g. `newArray#`, `readArray#`, `writeMutVar#`, `writeIOPort#`, etc. Additionally, exception handling functions such as `catch#`, `raise#`, `maskAsyncExceptions#`,... are made levity/representation-polymorphic. Now that Array# and MutableArray# also work with unlifted types, we can simply re-define ArrayArray# and MutableArrayArray# in terms of them. This means that ArrayArray# and MutableArrayArray# are no longer primitive types, but simply unlifted newtypes around Array# and MutableArrayArray#. This completes the implementation of the Pointer Rep proposal https://github.com/ghc-proposals/ghc-proposals/pull/203 Fixes #20911 ------------------------- Metric Increase: T12545 ------------------------- ------------------------- Metric Decrease: T12545 ------------------------- - - - - - 6e94ba54 by Andreas Klebinger at 2022-01-26T12:02:21-05:00 CorePrep: Don't try to wrap partial applications of primops in profiling ticks. This fixes #20938. - - - - - b55d7db3 by sheaf at 2022-01-26T12:03:01-05:00 Ensure that order of instances doesn't matter The insert_overlapping used in lookupInstEnv used to return different results depending on the order in which instances were processed. The problem was that we could end up discarding an overlapping instance in favour of a more specific non-overlapping instance. This is a problem because, even though we won't choose the less-specific instance for matching, it is still useful for pruning away other instances, because it has the overlapping flag set while the new instance doesn't. In insert_overlapping, we now keep a list of "guard" instances, which are instances which are less-specific that one that matches (and hence which we will discard in the end), but want to keep around solely for the purpose of eliminating other instances. Fixes #20946 - - - - - 61f62062 by sheaf at 2022-01-26T12:03:40-05:00 Remove redundant SOURCE import in FitTypes Fixes #20995 - - - - - e8405829 by sheaf at 2022-01-26T12:04:15-05:00 Fix haddock markup in GHC.Tc.Errors.Types - - - - - 590a2918 by Simon Peyton Jones at 2022-01-26T19:45:22-05:00 Make RULE matching insensitive to eta-expansion This patch fixes #19790 by making the rule matcher do on-the-fly eta reduction. See Note [Eta reduction the target] in GHC.Core.Rules I found I also had to careful about casts when matching; see Note [Casts in the target] and Note [Casts in the template] Lots more comments and Notes in the rule matcher - - - - - c61ac4d8 by Matthew Pickering at 2022-01-26T19:45:58-05:00 alwaysRerun generation of ghcconfig This file needs to match exactly what is passed as the testCompiler. Before this change the settings for the first compiler to be tested woudl be stored and not regenerated if --test-compiler changed. - - - - - b5132f86 by Matthew Pickering at 2022-01-26T19:45:58-05:00 Pass config.stage argument to testsuite - - - - - 83d3ad31 by Zubin Duggal at 2022-01-26T19:45:58-05:00 hadrian: Allow testing of the stage1 compiler (#20755) - - - - - a5924b38 by Joachim Breitner at 2022-01-26T19:46:34-05:00 Simplifier: Do the right thing if doFloatFromRhs = False If `doFloatFromRhs` is `False` then the result from `prepareBinding` should not be used. Previously it was in ways that are silly (but not completly wrong, as the simplifier would clean that up again, so no test case). This was spotted by Simon during a phone call. Fixes #20976 - - - - - ce488c2b by Simon Peyton Jones at 2022-01-26T19:47:09-05:00 Better occurrence analysis with casts This patch addresses #20988 by refactoring the way the occurrence analyser deals with lambdas. Previously it used collectBinders to split off a group of binders, and deal with them together. Now I deal with them one at a time in occAnalLam, which allows me to skip casts easily. See Note [Occurrence analysis for lambda binders] about "lambda-groups" This avoidance of splitting out a list of binders has some good consequences. Less code, more efficient, and I think, more clear. The Simplifier needed a similar change, now that lambda-groups can inlude casts. It turned out that I could simplify the code here too, in particular elminating the sm_bndrs field of StrictBind. Simpler, more efficient. Compile-time metrics improve slightly; here are the ones that are +/- 0.5% or greater: Baseline Test Metric value New value Change -------------------------------------------------------------------- T11303b(normal) ghc/alloc 40,736,702 40,543,992 -0.5% T12425(optasm) ghc/alloc 90,443,459 90,034,104 -0.5% T14683(normal) ghc/alloc 2,991,496,696 2,956,277,288 -1.2% T16875(normal) ghc/alloc 34,937,866 34,739,328 -0.6% T17977b(normal) ghc/alloc 37,908,550 37,709,096 -0.5% T20261(normal) ghc/alloc 621,154,237 618,312,480 -0.5% T3064(normal) ghc/alloc 190,832,320 189,952,312 -0.5% T3294(normal) ghc/alloc 1,604,674,178 1,604,608,264 -0.0% T5321FD(normal) ghc/alloc 270,540,489 251,888,480 -6.9% GOOD T5321Fun(normal) ghc/alloc 300,707,814 281,856,200 -6.3% GOOD WWRec(normal) ghc/alloc 588,460,916 585,536,400 -0.5% geo. mean -0.3% Metric Decrease: T5321FD T5321Fun - - - - - 4007905d by Roland Senn at 2022-01-26T19:47:47-05:00 Cleanup tests in directory ghci.debugger. Fixes #21009 * Remove wrong comment about panic in `break003.script`. * Improve test `break008`. * Add test `break028` to `all.T` * Fix wrong comments in `print019.script`, `print026.script` and `result001.script`. * Remove wrong comments from `print024.script` and `print031.script`. * Replace old module name with current name in `print035.script`. - - - - - 3577defb by Matthew Pickering at 2022-01-26T19:48:22-05:00 ci: Move source-tarball and test-bootstrap into full-build - - - - - 6e09b3cf by Matthew Pickering at 2022-01-27T02:39:35-05:00 ci: Add ENABLE_NUMA flag to explicitly turn on libnuma dependency In recent releases a libnuma dependency has snuck into our bindists because the images have started to contain libnuma. We now explicitly pass `--disable-numa` to configure unless explicitly told not to by using the `ENABLE_NUMA` environment variable. So this is tested, there is one random validate job which builds with --enable-numa so that the code in the RTS is still built. Fixes #20957 and #15444 - - - - - f4ce4186 by Simon Peyton Jones at 2022-01-27T02:40:11-05:00 Improve partial signatures As #20921 showed, with partial signatures, it is helpful to use the same algorithm (namely findInferredDiff) for * picking the constraints to retain for the /group/ in Solver.decideQuantification * picking the contraints to retain for the /individual function/ in Bind.chooseInferredQuantifiers This is still regrettably declicate, but it's a step forward. - - - - - 0573aeab by Simon Peyton Jones at 2022-01-27T02:40:11-05:00 Add an Outputable instance for RecTcChecker - - - - - f0adea14 by Ryan Scott at 2022-01-27T02:40:47-05:00 Expand type synonyms in markNominal `markNominal` is repsonsible for setting the roles of type variables that appear underneath an `AppTy` to be nominal. However, `markNominal` previously did not expand type synonyms, so in a data type like this: ```hs data M f a = MkM (f (T a)) type T a = Int ``` The `a` in `M f a` would be marked nominal, even though `T a` would simply expand to `Int`. The fix is simple: call `coreView` as appropriate in `markNominal`. This is much like the fix for #14101, but in a different spot. Fixes #20999. - - - - - 18df4013 by Simon Peyton Jones at 2022-01-27T08:22:30-05:00 Define and use restoreLclEnv This fixes #20981. See Note [restoreLclEnv vs setLclEnv] in GHC.Tc.Utils.Monad. I also use updLclEnv rather than get/set when I can, because it's then much clearer that it's an update rather than an entirely new TcLclEnv coming from who-knows-where. - - - - - 31088dd3 by David Feuer at 2022-01-27T08:23:05-05:00 Add test supplied in T20996 which uses data family result kind polymorphism David (@treeowl) writes: > Following @kcsongor, I've used ridiculous data family result kind > polymorphism in `linear-generics`, and am currently working on getting > it into `staged-gg`. If it should be removed, I'd appreciate a heads up, > and I imagine Csongor would too. > > What do I need by ridiculous polymorphic result kinds? Currently, data > families are allowed to have result kinds that end in `Type` (or maybe > `TYPE r`? I'm not sure), but not in concrete data kinds. However, they > *are* allowed to have polymorphic result kinds. This leads to things I > think most of us find at least quite *weird*. For example, I can write > > ```haskell > data family Silly :: k > data SBool :: Bool -> Type where > SFalse :: SBool False > STrue :: SBool True > SSSilly :: SBool Silly > type KnownBool b where > kb :: SBool b > instance KnownBool False where kb = SFalse > instance KnownBool True where kb = STrue > instance KnownBool Silly where kb = Silly > ``` > > Basically, every kind now has potentially infinitely many "legit" inhabitants. > > As horrible as that is, it's rather useful for GHC's current native > generics system. It's possible to use these absurdly polymorphic result > kinds to probe the structure of generic representations in a relatively > pleasant manner. It's a sort of "formal type application" reminiscent of > the notion of a formal power series (see the test case below). I suspect > a system more like `kind-generics` wouldn't need this extra probing > power, but nothing like that is natively available as yet. > > If the ridiculous result kind polymorphism is banished, we'll still be > able to do what we need as long as we have stuck type families. It's > just rather less ergonomical: a stuck type family has to be used with a > concrete marker type argument. Closes #20996 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 8fd2ac25 by Andreas Abel at 2022-01-27T18:34:54-05:00 Whitespace only - - - - - 7a854743 by Andreas Abel at 2022-01-27T18:34:54-05:00 Ctd. #18087: complete :since: info for all warnings in users guide Some warnings have been there "forever" and I could not trace back the exact genesis, so I wrote "since at least 5.04". The flag `helpful-errors` could have been added in 7.2 already. I wrote 7.4 since I have no 7.2 available and it is not recognized by 7.0. - - - - - f75411e8 by Andreas Abel at 2022-01-27T18:34:54-05:00 Re #18087 user's guide: add a note that -Wxxx used to be -fwarn-xxx The warning option syntax -W was introduced in GHC 8. The note should clarify what e.g. "since 7.6" means in connection with "-Wxxx": That "-fwarn-xxx" was introduced in 7.6.1. [ci skip] - - - - - 3cae7fde by Peter Trommler at 2022-01-27T18:35:30-05:00 testsuite: Fix AtomicPrimops test on big endian - - - - - 6cc6080c by Ben Gamari at 2022-01-27T18:36:05-05:00 users-guide: Document GHC_CHARENC environment variable As noted in #20963, this was introduced in 1b56c40578374a15b4a2593895710c68b0e2a717 but was no documentation was added at that point. Closes #20963. - - - - - ee21e2de by Ben Gamari at 2022-01-27T18:36:41-05:00 rts: Clean up RTS flags usage message Align flag descriptions and acknowledge that some flags may not be available unless the user linked with `-rtsopts` (as noted in #20961). Fixes #20961. - - - - - 7f8ce19e by Simon Peyton Jones at 2022-01-27T18:37:17-05:00 Fix getHasGivenEqs The second component is supposed to be "insoluble equalities arising from givens". But we were getting wanteds too; and that led to an outright duplication of constraints. It's not harmful, but it's not right either. I came across this when debugging something else. Easily fixed. - - - - - f9ef2d26 by Simon Peyton Jones at 2022-01-27T18:37:17-05:00 Set the TcLclEnv when solving a ForAll constraint Fix a simple omission in GHC.Tc.Solver.Canonical.solveForAll, where we ended up with the wrong TcLclEnv captured in an implication. Result: unhelpful error message (#21006) - - - - - bc6ba8ef by Sylvain Henry at 2022-01-28T12:14:41-05:00 Make most shifts branchless - - - - - 62a6d037 by Simon Peyton Jones at 2022-01-28T12:15:17-05:00 Improve boxity in deferAfterPreciseException As #20746 showed, the demand analyser behaved badly in a key I/O library (`GHC.IO.Handle.Text`), by unnessarily boxing and reboxing. This patch adjusts the subtle function deferAfterPreciseException; it's quite easy, just a bit subtle. See the new Note [deferAfterPreciseException] And this MR deals only with Problem 2 in #20746. Problem 1 is still open. - - - - - 42c47cd6 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts/trace: Shrink tracing flags - - - - - cee66e71 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts/EventLog: Mark various internal globals as static - - - - - 6b0cea29 by Ben Gamari at 2022-01-29T02:40:45-05:00 Propagate PythonCmd to make build system - - - - - 2e29edb7 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts: Refactor event types Previously we would build the eventTypes array at runtime during RTS initialization. However, this is completely unnecessary; it is completely static data. - - - - - bb15c347 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts/eventlog: Ensure that flushCount is initialized - - - - - 268efcc9 by Matthew Pickering at 2022-01-29T02:41:21-05:00 Rework the handling of SkolemInfo The main purpose of this patch is to attach a SkolemInfo directly to each SkolemTv. This fixes the large number of bugs which have accumulated over the years where we failed to report errors due to having "no skolem info" for particular type variables. Now the origin of each type varible is stored on the type variable we can always report accurately where it cames from. Fixes #20969 #20732 #20680 #19482 #20232 #19752 #10946 #19760 #20063 #13499 #14040 The main changes of this patch are: * SkolemTv now contains a SkolemInfo field which tells us how the SkolemTv was created. Used when reporting errors. * Enforce invariants relating the SkolemInfoAnon and level of an implication (ic_info, ic_tclvl) to the SkolemInfo and level of the type variables in ic_skols. * All ic_skols are TcTyVars -- Check is currently disabled * All ic_skols are SkolemTv * The tv_lvl of the ic_skols agrees with the ic_tclvl * The ic_info agrees with the SkolInfo of the implication. These invariants are checked by a debug compiler by checkImplicationInvariants. * Completely refactor kcCheckDeclHeader_sig which kept doing my head in. Plus, it wasn't right because it wasn't skolemising the binders as it decomposed the kind signature. The new story is described in Note [kcCheckDeclHeader_sig]. The code is considerably shorter than before (roughly 240 lines turns into 150 lines). It still has the same awkward complexity around computing arity as before, but that is a language design issue. See Note [Arity inference in kcCheckDeclHeader_sig] * I added new type synonyms MonoTcTyCon and PolyTcTyCon, and used them to be clear which TcTyCons have "finished" kinds etc, and which are monomorphic. See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] * I renamed etaExpandAlgTyCon to splitTyConKind, becuase that's a better name, and it is very useful in kcCheckDeclHeader_sig, where eta-expansion isn't an issue. * Kill off the nasty `ClassScopedTvEnv` entirely. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 0a1d0944 by Ben Gamari at 2022-01-29T14:52:55-05:00 Drop SPARC NCG - - - - - 313afb3d by Ben Gamari at 2022-01-29T14:52:56-05:00 A few comment cleanups - - - - - d85a527f by Ben Gamari at 2022-01-29T14:52:56-05:00 Rip out SPARC register support - - - - - c6bede69 by Ben Gamari at 2022-01-29T14:52:56-05:00 rts: Rip out SPARC support - - - - - a67c2471 by Ben Gamari at 2022-01-29T14:52:56-05:00 Rip out remaining SPARC support - - - - - 5771b690 by Ben Gamari at 2022-01-29T14:52:56-05:00 CmmToAsm: Drop RegPair SPARC was its last and only user. - - - - - 512ed3f1 by Ben Gamari at 2022-01-29T14:52:56-05:00 CmmToAsm: Make RealReg a newtype Now that RegPair is gone we no longer need to pay for the additional box. - - - - - 88fea6aa by Ben Gamari at 2022-01-29T14:52:56-05:00 rts: Drop redundant #include <Arena.h> - - - - - ea2a4034 by Ben Gamari at 2022-01-29T14:52:56-05:00 CmmToAsm: Drop ncgExpandTop This was only needed for SPARC's synthetic instructions. - - - - - 88fce740 by Ben Gamari at 2022-01-29T14:54:04-05:00 rel-notes: Note dropping of SPARC support - - - - - eb956cf1 by Ben Gamari at 2022-01-30T06:27:19-05:00 testsuite: Force-enable caret diagnostics in T17786 Otherwise GHC realizes that it's not attached to a proper tty and will disable caret diagnostics. - - - - - d07799ab by Ben Gamari at 2022-01-30T06:27:19-05:00 testsuite: Make T7275 more robust against CCid changes The cost-center numbers are somewhat unstable; normalise them out. - - - - - c76c8050 by Ben Gamari at 2022-01-30T06:27:19-05:00 rts: Don't allocate closurePtrs# pointers on C stack Previously `closurePtrs#` would allocate an aray of the size of the closure being decoded on the C stack. This was ripe for overflowing the C stack overflow. This resulted in `T12492` failing on Windows. - - - - - 3af95f7a by Ben Gamari at 2022-01-30T06:27:19-05:00 testsuite/T4029: Don't depend on echo On Windows the `cmd.exe` shell may be used to execute the command, which will print `ECHO is on.` instead of a newline if you give it no argument. Avoid this by rather using `printf`. - - - - - 3531c478 by Ben Gamari at 2022-01-30T06:27:19-05:00 Use PATH_FMT instead of %s to format `pathchar *` A few %s occurrences have snuck in over the past months. - - - - - ee5c4f9d by Zubin Duggal at 2022-01-31T16:51:55+05:30 Improve migration strategy for the XDG compliance change to the GHC application directory. We want to always use the old path (~/.ghc/..) if it exists. But we never want to create the old path. This ensures that the migration can eventually be completed once older GHC versions are no longer in circulation. Fixes #20684, #20669, #20660 - - - - - 60a54a8f by doyougnu at 2022-01-31T18:46:11-05:00 StgToCmm: decouple DynFlags, add StgToCmmConfig StgToCmm: add Config, remove CgInfoDownwards StgToCmm: runC api change to take StgToCmmConfig StgToCmm: CgInfoDownad -> StgToCmmConfig StgToCmm.Monad: update getters/setters/withers StgToCmm: remove CallOpts in StgToCmm.Closure StgToCmm: remove dynflag references StgToCmm: PtrOpts removed StgToCmm: add TMap to config, Prof - dynflags StgToCmm: add omit yields to config StgToCmm.ExtCode: remove redundant import StgToCmm.Heap: remove references to dynflags StgToCmm: codeGen api change, DynFlags -> Config StgToCmm: remove dynflags in Env and StgToCmm StgToCmm.DataCon: remove dynflags references StgToCmm: remove dynflag references in DataCon StgToCmm: add backend avx flags to config StgToCmm.Prim: remove dynflag references StgToCmm.Expr: remove dynflag references StgToCmm.Bind: remove references to dynflags StgToCmm: move DoAlignSanitisation to Cmm.Type StgToCmm: remove PtrOpts in Cmm.Parser.y DynFlags: update ipInitCode api StgToCmm: Config Module is single source of truth StgToCmm: Lazy config breaks IORef deadlock testsuite: bump countdeps threshold StgToCmm.Config: strictify fields except UpdFrame Strictifying UpdFrameOffset causes the RTS build with stage1 to deadlock. Additionally, before the deadlock performance of the RTS is noticeably slower. StgToCmm.Config: add field descriptions StgToCmm: revert strictify on Module in config testsuite: update CountDeps tests StgToCmm: update comment, fix exports Specifically update comment about loopification passed into dynflags then stored into stgToCmmConfig. And remove getDynFlags from Monad.hs exports Types.Name: add pprFullName function StgToCmm.Ticky: use pprFullname, fixup ExtCode imports Cmm.Info: revert cmmGetClosureType removal StgToCmm.Bind: use pprFullName, Config update comments StgToCmm: update closureDescription api StgToCmm: SAT altHeapCheck StgToCmm: default render for Info table, ticky Use default rendering contexts for info table and ticky ticky, which should be independent of command line input. testsuite: bump count deps pprFullName: flag for ticky vs normal style output convertInfoProvMap: remove unused parameter StgToCmm.Config: add backend flags to config StgToCmm.Config: remove Backend from Config StgToCmm.Prim: refactor Backend call sites StgToCmm.Prim: remove redundant imports StgToCmm.Config: refactor vec compatibility check StgToCmm.Config: add allowQuotRem2 flag StgToCmm.Ticky: print internal names with parens StgToCmm.Bind: dispatch ppr based on externality StgToCmm: Add pprTickyname, Fix ticky naming Accidently removed the ctx for ticky SDoc output. The only relevant flag is sdocPprDebug which was accidental set to False due to using defaultSDocContext without altering the flag. StgToCmm: remove stateful fields in config fixup: config: remove redundant imports StgToCmm: move Sequel type to its own module StgToCmm: proliferate getCallMethod updated api StgToCmm.Monad: add FCodeState to Monad Api StgToCmm: add second reader monad to FCode fixup: Prim.hs: missed a merge conflict fixup: Match countDeps tests to HEAD StgToCmm.Monad: withState -> withCgState To disambiguate it from mtl withState. This withState shouldn't be returning the new state as a value. However, fixing this means tackling the knot tying in CgState and so is very difficult since it changes when the thunk of the knot is forced which either leads to deadlock or to compiler panic. - - - - - 58eccdbc by Ben Gamari at 2022-01-31T18:46:47-05:00 codeGen: Fix two buglets in -fbounds-check logic @Bodigrim noticed that the `compareByteArray#` bounds-checking logic had flipped arguments and an off-by-one. For the sake of clarity I also refactored occurrences of `cmmOffset` to rather use `cmmOffsetB`. I suspect the former should be retired. - - - - - 584f03fa by Simon Peyton Jones at 2022-01-31T18:47:23-05:00 Make typechecker trace less strict Fixes #21011 - - - - - 60ac7300 by Elton at 2022-02-01T12:28:49-05:00 Use braces in TH case pprint (fixes #20893) This patch ensures that the pretty printer formats `case` statements using braces (instead of layout) to remain consistent with the formatting of other statements (like `do`) - - - - - fdda93b0 by Elton at 2022-02-01T12:28:49-05:00 Use braces in TH LambdaCase and where clauses This patch ensures that the pretty printer formats LambdaCase and where clauses using braces (instead of layout) to remain consistent with the formatting of other statements (like `do` and `case`) - - - - - 06185102 by Ben Gamari at 2022-02-01T12:29:26-05:00 Consistently upper-case "Note [" This was achieved with git ls-tree --name-only HEAD -r | xargs sed -i -e 's/note \[/Note \[/g' - - - - - 88fba8a4 by Ben Gamari at 2022-02-01T12:29:26-05:00 Fix a few Note inconsistencies - - - - - 05548a22 by Douglas Wilson at 2022-02-02T19:26:06-05:00 rts: Address failures to inline - - - - - 074945de by Simon Peyton Jones at 2022-02-02T19:26:41-05:00 Two small improvements in the Simplifier As #20941 describes, this patch implements a couple of small fixes to the Simplifier. They make a difference principally with -O0, so few people will notice. But with -O0 they can reduce the number of Simplifer iterations. * In occurrence analysis we avoid making x = (a,b) into a loop breaker because we want to be able to inline x, or (more likely) do case-elimination. But HEAD does not treat x = let y = blah in (a,b) in the same way. We should though, because we are going to float that y=blah out of the x-binding. A one-line fix in OccurAnal. * The crucial function exprIsConApp_maybe uses getUnfoldingInRuleMatch (rightly) but the latter was deeply strange. In HEAD, if rule-rewriting was off (-O0) we only looked inside stable unfoldings. Very stupid. The patch simplifies. * I also noticed that in simplStableUnfolding we were failing to delete the DFun binders from the usage. So I added that. Practically zero perf change across the board, except that we get more compiler allocation in T3064 (which is compiled with -O0). There's a good reason: we get better code. But there are lots of other small compiler allocation decreases: Metrics: compile_time/bytes allocated --------------------- Baseline Test Metric value New value Change ----------------------------------------------------------------- PmSeriesG(normal) ghc/alloc 44,260,817 44,184,920 -0.2% PmSeriesS(normal) ghc/alloc 52,967,392 52,891,632 -0.1% PmSeriesT(normal) ghc/alloc 75,498,220 75,421,968 -0.1% PmSeriesV(normal) ghc/alloc 52,341,849 52,265,768 -0.1% T10421(normal) ghc/alloc 109,702,291 109,626,024 -0.1% T10421a(normal) ghc/alloc 76,888,308 76,809,896 -0.1% T10858(normal) ghc/alloc 125,149,038 125,073,648 -0.1% T11276(normal) ghc/alloc 94,159,364 94,081,640 -0.1% T11303b(normal) ghc/alloc 40,230,059 40,154,368 -0.2% T11822(normal) ghc/alloc 107,424,540 107,346,088 -0.1% T12150(optasm) ghc/alloc 76,486,339 76,426,152 -0.1% T12234(optasm) ghc/alloc 55,585,046 55,507,352 -0.1% T12425(optasm) ghc/alloc 88,343,288 88,265,312 -0.1% T13035(normal) ghc/alloc 98,919,768 98,845,600 -0.1% T13253-spj(normal) ghc/alloc 121,002,153 120,851,040 -0.1% T16190(normal) ghc/alloc 290,313,131 290,074,152 -0.1% T16875(normal) ghc/alloc 34,756,121 34,681,440 -0.2% T17836b(normal) ghc/alloc 45,198,100 45,120,288 -0.2% T17977(normal) ghc/alloc 39,479,952 39,404,112 -0.2% T17977b(normal) ghc/alloc 37,213,035 37,137,728 -0.2% T18140(normal) ghc/alloc 79,430,588 79,350,680 -0.1% T18282(normal) ghc/alloc 128,303,182 128,225,384 -0.1% T18304(normal) ghc/alloc 84,904,713 84,831,952 -0.1% T18923(normal) ghc/alloc 66,817,241 66,731,984 -0.1% T20049(normal) ghc/alloc 86,188,024 86,107,920 -0.1% T5837(normal) ghc/alloc 35,540,598 35,464,568 -0.2% T6048(optasm) ghc/alloc 99,812,171 99,736,032 -0.1% T9198(normal) ghc/alloc 46,380,270 46,304,984 -0.2% geo. mean -0.0% Metric Increase: T3064 - - - - - d2cce453 by Morrow at 2022-02-02T19:27:21-05:00 Fix @since annotation on Nat - - - - - 6438fed9 by Simon Peyton Jones at 2022-02-02T19:27:56-05:00 Refactor the escaping kind check for data constructors As #20929 pointed out, we were in-elegantly checking for escaping kinds in `checkValidType`, even though that check was guaranteed to succeed for type signatures -- it's part of kind-checking a type. But for /data constructors/ we kind-check the pieces separately, so we still need the check. This MR is a pure refactor, moving the test from `checkValidType` to `checkValidDataCon`. No new tests; external behaviour doesn't change. - - - - - fb05e5ac by Andreas Klebinger at 2022-02-02T19:28:31-05:00 Replace sndOfTriple with sndOf3 I also cleaned up the imports slightly while I was at it. - - - - - fbc77d3a by Matthew Pickering at 2022-02-02T19:29:07-05:00 testsuite: Honour PERF_BASELINE_COMMIT when computing allowed metric changes We now get all the commits between the PERF_BASELINE_COMMIT and HEAD and check any of them for metric changes. Fixes #20882 - - - - - 0a82ae0d by Simon Peyton Jones at 2022-02-02T23:49:58-05:00 More accurate unboxing This patch implements a fix for #20817. It ensures that * The final strictness signature for a function accurately reflects the unboxing done by the wrapper See Note [Finalising boxity for demand signatures] and Note [Finalising boxity for let-bound Ids] * A much better "layer-at-a-time" implementation of the budget for how many worker arguments we can have See Note [Worker argument budget] Generally this leads to a bit more worker/wrapper generation, because instead of aborting entirely if the budget is exceeded (and then lying about boxity), we unbox a bit. Binary sizes in increase slightly (around 1.8%) because of the increase in worker/wrapper generation. The big effects are to GHC.Ix, GHC.Show, GHC.IO.Handle.Internals. If we did a better job of dropping dead code, this effect might go away. Some nofib perf improvements: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- VSD +1.8% -0.5% 0.017 0.017 0.0% awards +1.8% -0.1% +2.3% +2.3% 0.0% banner +1.7% -0.2% +0.3% +0.3% 0.0% bspt +1.8% -0.1% +3.1% +3.1% 0.0% eliza +1.8% -0.1% +1.2% +1.2% 0.0% expert +1.7% -0.1% +9.6% +9.6% 0.0% fannkuch-redux +1.8% -0.4% -9.3% -9.3% 0.0% kahan +1.8% -0.1% +22.7% +22.7% 0.0% maillist +1.8% -0.9% +21.2% +21.6% 0.0% nucleic2 +1.7% -5.1% +7.5% +7.6% 0.0% pretty +1.8% -0.2% 0.000 0.000 0.0% reverse-complem +1.8% -2.5% +12.2% +12.2% 0.0% rfib +1.8% -0.2% +2.5% +2.5% 0.0% scc +1.8% -0.4% 0.000 0.000 0.0% simple +1.7% -1.3% +17.0% +17.0% +7.4% spectral-norm +1.8% -0.1% +6.8% +6.7% 0.0% sphere +1.7% -2.0% +13.3% +13.3% 0.0% tak +1.8% -0.2% +3.3% +3.3% 0.0% x2n1 +1.8% -0.4% +8.1% +8.1% 0.0% -------------------------------------------------------------------------------- Min +1.1% -5.1% -23.6% -23.6% 0.0% Max +1.8% +0.0% +36.2% +36.2% +7.4% Geometric Mean +1.7% -0.1% +6.8% +6.8% +0.1% Compiler allocations in CI have a geometric mean of +0.1%; many small decreases but there are three bigger increases (7%), all because we do more worker/wrapper than before, so there is simply more code to compile. That's OK. Perf benchmarks in perf/should_run improve in allocation by a geo mean of -0.2%, which is good. None get worse. T12996 improves by -5.8% Metric Decrease: T12996 Metric Increase: T18282 T18923 T9630 - - - - - d1ef6288 by Peter Trommler at 2022-02-02T23:50:34-05:00 Cmm: fix equality of expressions Compare expressions and types when comparing `CmmLoad`s. Fixes #21016 - - - - - e59446c6 by Peter Trommler at 2022-02-02T23:50:34-05:00 Check type first then expression - - - - - b0e1ef4a by Matthew Pickering at 2022-02-03T14:44:17-05:00 Add failing test for #20791 The test produces different output on static vs dynamic GHC builds. - - - - - cae1fb17 by Matthew Pickering at 2022-02-03T14:44:17-05:00 Frontend01 passes with static GHC - - - - - e343526b by Matthew Pickering at 2022-02-03T14:44:17-05:00 Don't initialise plugins when there are no pipelines to run - - - - - abac45fc by Matthew Pickering at 2022-02-03T14:44:17-05:00 Mark prog003 as expected_broken on static way #20704 - - - - - 13300dfd by Matthew Pickering at 2022-02-03T14:44:17-05:00 Filter out -rtsopts in T16219 to make static/dynamic ways agree - - - - - d89439f2 by Matthew Pickering at 2022-02-03T14:44:17-05:00 T13168: Filter out rtsopts for consistency between dynamic and static ways - - - - - 00180cdf by Matthew Pickering at 2022-02-03T14:44:17-05:00 Accept new output for T14335 test This test was previously not run due to #20960 - - - - - 1accdcff by Matthew Pickering at 2022-02-03T14:44:17-05:00 Add flushes to plugin tests which print to stdout Due to #20791 you need to explicitly flush as otherwise the output from these tests doesn't make it to stdout. - - - - - d820f2e8 by Matthew Pickering at 2022-02-03T14:44:17-05:00 Remove ghc_plugin_way Using ghc_plugin_way had the unintended effect of meaning certain tests weren't run at all when ghc_dynamic=true, if you delete this modifier then the tests work in both the static and dynamic cases. - - - - - aa5ef340 by Matthew Pickering at 2022-02-03T14:44:17-05:00 Unbreak T13168 on windows Fixes #14276 - - - - - 84ab0153 by Matthew Pickering at 2022-02-03T14:44:53-05:00 Rewrite CallerCC parser using ReadP This allows us to remove the dependency on parsec and hence transitively on text. Also added some simple unit tests for the parser and fixed two small issues in the documentation. Fixes #21033 - - - - - 4e6780bb by Matthew Pickering at 2022-02-03T14:45:28-05:00 ci: Add debian 11 jobs (validate/release/nightly) Fixes #21002 - - - - - eddaa591 by Ben Gamari at 2022-02-04T10:01:59-05:00 compiler: Introduce and use RoughMap for instance environments Here we introduce a new data structure, RoughMap, inspired by the previous `RoughTc` matching mechanism for checking instance matches. This allows [Fam]InstEnv to be implemented as a trie indexed by these RoughTc signatures, reducing the complexity of instance lookup and FamInstEnv merging (done during the family instance conflict test) from O(n) to O(log n). The critical performance improvement currently realised by this patch is in instance matching. In particular the RoughMap mechanism allows us to discount many potential instances which will never match for constraints involving type variables (see Note [Matching a RoughMap]). In realistic code bases matchInstEnv was accounting for 50% of typechecker time due to redundant work checking instances when simplifying instance contexts when deriving instances. With this patch the cost is significantly reduced. The larger constants in InstEnv creation do mean that a few small tests regress in allocations slightly. However, the runtime of T19703 is reduced by a factor of 4. Moreover, the compilation time of the Cabal library is slightly improved. A couple of test cases are included which demonstrate significant improvements in compile time with this patch. This unfortunately does not fix the testcase provided in #19703 but does fix #20933 ------------------------- Metric Decrease: T12425 Metric Increase: T13719 T9872a T9872d hard_hole_fits ------------------------- Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 62d670eb by Matthew Pickering at 2022-02-04T10:02:35-05:00 testsuite: Run testsuite dependency calculation before GHC is built The main motivation for this patch is to allow tests to be added to the testsuite which test things about the source tree without needing to build GHC. In particular the notes linter can easily start failing and by integrating it into the testsuite the process of observing these changes is caught by normal validation procedures rather than having to run the linter specially. With this patch I can run ``` ./hadrian/build test --flavour=devel2 --only="uniques" ``` In a clean tree to run the checkUniques linter without having to build GHC. Fixes #21029 - - - - - 4bd52410 by Hécate Moonlight at 2022-02-04T16:14:10-05:00 Add the Ix class to Foreign C integral types Related CLC proposal is here: https://github.com/haskell/core-libraries-committee/issues/30 - - - - - de6d7692 by Ben Gamari at 2022-02-04T16:14:47-05:00 Drop dead code - - - - - b79206f1 by Ben Gamari at 2022-02-04T16:14:47-05:00 Add comments - - - - - 58d7faac by Ben Gamari at 2022-02-04T16:14:47-05:00 cmm: Introduce cmmLoadBWord and cmmLoadGCWord - - - - - 7217156c by Ben Gamari at 2022-02-04T16:14:47-05:00 Introduce alignment in CmmLoad - - - - - 99ea5f2c by Ben Gamari at 2022-02-04T16:14:47-05:00 Introduce alignment to CmmStore - - - - - 606b59a5 by Ben Gamari at 2022-02-04T16:14:47-05:00 Fix array primop alignment - - - - - 1cf9616a by Ben Gamari at 2022-02-04T16:14:47-05:00 llvmGen: Handle unaligned loads/stores This allows us to produce valid code for indexWord8ArrayAs*# on platforms that lack unaligned memory access. - - - - - 8c18feba by Ben Gamari at 2022-02-04T16:14:47-05:00 primops: Fix documentation of setByteArray# Previously the documentation was subtly incorrect regarding the bounds of the operation. Fix this and add a test asserting that a zero-length operation is in fact a no-op. - - - - - 88480e55 by nineonine at 2022-02-04T20:35:45-05:00 Fix unsound behavior of unlifted datatypes in ghci (#20194) Previously, directly calling a function that pattern matches on an unlifted data type which has at least two constructors in GHCi resulted in a segfault. This happened due to unaccounted return frame info table pointer. The fix is to pop the above mentioned frame info table pointer when unlifted things are returned. See Note [Popping return frame for unlifted things] authors: bgamari, nineonine - - - - - a5c7068c by Simon Peyton Jones at 2022-02-04T20:36:20-05:00 Add Outputable instance for Messages c.f. #20980 - - - - - bf495f72 by Simon Peyton Jones at 2022-02-04T20:36:20-05:00 Add a missing restoreLclEnv The commit commit 18df4013f6eaee0e1de8ebd533f7e96c4ee0ff04 Date: Sat Jan 22 01:12:30 2022 +0000 Define and use restoreLclEnv omitted to change one setLclEnv to restoreLclEnv, namely the one in GHC.Tc.Errors.warnRedundantConstraints. This new commit fixes the omission. - - - - - 6af8e71e by Simon Peyton Jones at 2022-02-04T20:36:20-05:00 Improve errors for non-existent labels This patch fixes #17469, by improving matters when you use non-existent field names in a record construction: data T = MkT { x :: Int } f v = MkT { y = 3 } The check is now made in the renamer, in GHC.Rename.Env.lookupRecFieldOcc. That in turn led to a spurious error in T9975a, which is fixed by making GHC.Rename.Names.extendGlobalRdrEnvRn fail fast if it finds duplicate bindings. See Note [Fail fast on duplicate definitions] in that module for more details. This patch was originated and worked on by Alex D (@nineonine) - - - - - 299acff0 by nineonine at 2022-02-05T19:21:49-05:00 Exit with failure when -e fails (fixes #18411 #9916 #17560) - - - - - 549292eb by Matthew Pickering at 2022-02-05T19:22:25-05:00 Make implication tidying agree with Note [Tidying multiple names at once] Note [Tidying multiple names at once] indicates that if multiple variables have the same name then we shouldn't prioritise one of them and instead rename them all to a1, a2, a3... etc This patch implements that change, some error message changes as expected. Closes #20932 - - - - - 2e9248b7 by Ben Gamari at 2022-02-06T01:43:56-05:00 rts/m32: Accept any address within 4GB of program text Previously m32 would assume that the program image was located near the start of the address space and therefore assume that it wanted pages in the bottom 4GB of address space. Instead we now check whether they are within 4GB of whereever the program is loaded. This is necessary on Windows, which now tends to place the image in high memory. The eventual goal is to use m32 to allocate memory for linker sections on Windows. - - - - - 86589b89 by GHC GitLab CI at 2022-02-06T01:43:56-05:00 rts: Generalize mmapForLinkerMarkExecutable Renamed to mprotectForLinker and allowed setting of arbitrary protection modes. - - - - - 88ef270a by GHC GitLab CI at 2022-02-06T01:43:56-05:00 rts/m32: Add consistency-checking infrastructure This adds logic, enabled in the `-debug` RTS for checking the internal consistency of the m32 allocator. This area has always made me a bit nervous so this should help me sleep better at night in exchange for very little overhead. - - - - - 2d6f0b17 by Ben Gamari at 2022-02-06T01:43:56-05:00 rts/m32: Free large objects back to the free page pool Not entirely convinced that this is worth doing. - - - - - e96f50be by GHC GitLab CI at 2022-02-06T01:43:56-05:00 rts/m32: Increase size of free page pool to 256 pages - - - - - fc083b48 by Ben Gamari at 2022-02-06T01:43:56-05:00 rts: Dump memory map on memory mapping failures Fixes #20992. - - - - - 633296bc by Ben Gamari at 2022-02-06T01:43:56-05:00 Fix macro redefinition warnings for PRINTF * Move `PRINTF` macro from `Stats.h` to `Stats.c` as it's only needed in the latter. * Undefine `PRINTF` at the end of `Messages.h` to avoid leaking it. - - - - - 37d435d2 by John Ericson at 2022-02-06T01:44:32-05:00 Purge DynFlags from GHC.Stg Also derive some more instances. GHC doesn't need them, but downstream consumers may need to e.g. put stuff in maps. - - - - - 886baa34 by Peter Trommler at 2022-02-06T10:58:18+01:00 RTS: Fix cabal specification In 35bea01b xxhash.c was removed. Remove the extra-source-files stanza referring to it. - - - - - 27581d77 by nineonine at 2022-02-06T20:50:44-05:00 hadrian: remove redundant import - - - - - 4ff19981 by John Ericson at 2022-02-07T11:04:43-05:00 GHC.HsToCore.Coverage: No more HscEnv, less DynFlags Progress towards #20730 - - - - - b09389a6 by John Ericson at 2022-02-07T11:04:43-05:00 Create `CoverageConfig` As requested by @mpickering to collect the information we project from `HscEnv` - - - - - ff867c46 by Greg Steuck at 2022-02-07T11:05:24-05:00 Avoid using removed utils/checkUniques in validate Asked the question: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7460/diffs#4061f4d17546e239dd10d78c6b48668c2a288e02_1_0 - - - - - a9355e84 by sheaf at 2022-02-08T05:27:25-05:00 Allow HasField in quantified constraints We perform validity checking on user-written HasField instances, for example to disallow: data Foo a = Foo { fld :: Int } instance HasField "fld" (Foo a) Bool However, these checks were also being made on quantified constraints, e.g. data Bar where Bar :: (forall a. HasField s (Foo a) Int) => Proxy s -> Bar This patch simply skips validity checking for quantified constraints, in line with what we already do for equality constraints such as Coercible. Fixes #20989 - - - - - 6d77d3d8 by sheaf at 2022-02-08T05:28:05-05:00 Relax TyEq:N: allow out-of-scope newtype DataCon The 'bad_newtype' assertion in GHC.Tc.Solver.Canonical.canEqCanLHSFinish failed to account for the possibility that the newtype constructor might not be in scope, in which case we don't provide any guarantees about canonicalising away a newtype on the RHS of a representational equality. Fixes #21010 - - - - - a893d2f3 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Remove linter dependency on lint-submods - - - - - 457a5b9c by Ben Gamari at 2022-02-08T05:28:42-05:00 notes-util: initial commit - - - - - 1a943859 by Ben Gamari at 2022-02-08T05:28:42-05:00 gitlab-ci: Add lint-notes job - - - - - bc5cbce6 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Add notes linter to testsuite - - - - - 38c6e301 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Fix some notes - - - - - c3aac0f8 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Add suggestion mode to notes-util - - - - - 5dd29aea by Cale Gibbard at 2022-02-08T05:29:18-05:00 `hscSimpleIface` drop fingerprint param and ret `hscSimpleIface` does not depend on or modify the `Maybe Fingerprint` it is given, only passes it through, so get rid of the extraneous passing. Perhaps the intent was that there would be an iface fingerprint check of some sort? but this was never done. If/when we we want to do that, we can add it back then. - - - - - 4bcbd731 by Cale Gibbard at 2022-02-08T05:29:54-05:00 Document `hscIncrementalFrontend` and flip bool - - - - - b713db1e by John Ericson at 2022-02-08T05:30:29-05:00 StgToCmm: Get rid of GHC.Driver.Session imports `DynFlags` is gone, but let's move a few trivial things around to get rid of its module too. - - - - - f115c382 by Gleb Popov at 2022-02-08T05:31:05-05:00 Fix build on recent FreeBSD. Recent FreeBSD versions gained the sched_getaffinity function, which made two mutually exclusive #ifdef blocks to be enabled. - - - - - 3320ab40 by Ben Gamari at 2022-02-08T10:42:04-05:00 rts/MemoryMap: Use mach_-prefixed type names There appears to be some inconsistency in system-call type naming across Darwin toolchains. Specifically: * the `address` argument to `mach_vm_region` apparently wants to be a `mach_vm_address_t *`, not a `vm_address_t *` * the `vmsize` argument to `mach_vm_region` wants to be a `mach_vm_size_t`, not a `vm_size_t` - - - - - b33f0cfa by Richard Eisenberg at 2022-02-08T10:42:41-05:00 Document that reifyRoles includes kind parameters Close #21056 - - - - - bd493ed6 by PHO at 2022-02-08T10:43:19-05:00 Don't try to build stage1 with -eventlog if stage0 doesn't provide it Like -threaded, stage0 isn't guaranteed to have an event-logging RTS. - - - - - 03c2de0f by Matthew Pickering at 2022-02-09T03:56:22-05:00 testsuite: Use absolute paths for config.libdir Fixes #21052 - - - - - ef294525 by Matthew Pickering at 2022-02-09T03:56:22-05:00 testsuite: Clean up old/redundant predicates - - - - - a39ed908 by Matthew Pickering at 2022-02-09T03:56:22-05:00 testsuite: Add missing dependency on ghcconfig - - - - - a172be07 by PHO at 2022-02-09T03:56:59-05:00 Implement System.Environment.getExecutablePath for NetBSD and also use it from GHC.BaseDir.getBaseDir - - - - - 62fa126d by PHO at 2022-02-09T03:57:37-05:00 Fix a portability issue in m4/find_llvm_prog.m4 `test A == B' is a Bash extension, which doesn't work on platforms where /bin/sh is not Bash. - - - - - fd9981e3 by Ryan Scott at 2022-02-09T03:58:13-05:00 Look through untyped TH splices in tcInferAppHead_maybe Previously, surrounding a head expression with a TH splice would defeat `tcInferAppHead_maybe`, preventing some expressions from typechecking that used to typecheck in previous GHC versions (see #21038 for examples). This is simple enough to fix: just look through `HsSpliceE`s in `tcInferAppHead_maybe`. I've added some additional prose to `Note [Application chains and heads]` in `GHC.Tc.Gen.App` to accompany this change. Fixes #21038. - - - - - 00975981 by sheaf at 2022-02-09T03:58:53-05:00 Add test for #21037 This program was rejected by GHC 9.2, but is accepted on newer versions of GHC. This patch adds a regression test. Closes #21037 - - - - - fad0b2b0 by Ben Gamari at 2022-02-09T08:29:46-05:00 Rename -merge-objs flag to --merge-objs For consistency with --make and friends. - - - - - 1dbe5b2a by Matthew Pickering at 2022-02-09T08:30:22-05:00 driver: Filter out our own boot module in hptSomeThingsBelow hptSomeThingsBelow would return a list of modules which contain the .hs-boot file for a particular module. This caused some problems because we would try and find the module in the HPT (but it's not there when we're compiling the module itself). Fixes #21058 - - - - - 2b1cced1 by Sylvain Henry at 2022-02-09T20:42:23-05:00 NCG: minor code factorization - - - - - e01ffec2 by Sylvain Henry at 2022-02-09T20:42:23-05:00 ByteCode: avoid out-of-bound read Cf https://gitlab.haskell.org/ghc/ghc/-/issues/18431#note_287139 - - - - - 53c26e79 by Ziyang Liu at 2022-02-09T20:43:02-05:00 Include ru_name in toHsRule message See #18147 - - - - - 3df06922 by Ben Gamari at 2022-02-09T20:43:39-05:00 rts: Rename MemoryMap.[ch] -> ReportMemoryMap.[ch] - - - - - e219ac82 by Ben Gamari at 2022-02-09T20:43:39-05:00 rts: Move mmapForLinker and friends to linker/MMap.c They are not particularly related to linking. - - - - - 30e205ca by Ben Gamari at 2022-02-09T20:43:39-05:00 rts/linker: Drop dead IA64 code - - - - - 4d3a306d by Ben Gamari at 2022-02-09T20:43:39-05:00 rts/linker/MMap: Use MemoryAccess in mmapForLinker - - - - - 1db4f1fe by Ben Gamari at 2022-02-09T20:43:39-05:00 linker: Don't use MAP_FIXED As noted in #21057, we really shouldn't be using MAP_FIXED. I would much rather have the process crash with a "failed to map" error than randomly overwrite existing mappings. Closes #21057. - - - - - 1eeae25c by Ben Gamari at 2022-02-09T20:43:39-05:00 rts/mmap: Refactor mmapForLinker Here we try to separate the policy decisions of where to place mappings from the mechanism of creating the mappings. This makes things significantly easier to follow. - - - - - ac2d18a7 by sheaf at 2022-02-09T20:44:18-05:00 Add some perf tests for coercions This patch adds some performance tests for programs that create large coercions. This is useful because the existing test coverage is not very representative of real-world situations. In particular, this adds a test involving an extensible records library, a common pain-point for users. - - - - - 48f25715 by Andreas Klebinger at 2022-02-10T04:35:35-05:00 Add late cost centre support This allows cost centres to be inserted after the core optimization pipeline has run. - - - - - 0ff70427 by Andreas Klebinger at 2022-02-10T04:36:11-05:00 Docs:Mention that safe calls don't keep their arguments alive. - - - - - 1d3ed168 by Ben Gamari at 2022-02-10T04:36:46-05:00 PEi386: Drop Windows Vista fallback in addLibrarySearchPath We no longer support Windows Vista. - - - - - 2a6f2681 by Ben Gamari at 2022-02-10T04:36:46-05:00 linker/PEi386: Make addLibrarySearchPath long-path aware Previously `addLibrarySearchPath` failed to normalise the added path to UNC form before passing it to `AddDllDirectory`. Consequently, the call was subject to the MAX_PATH restriction, leading to the failure of `test-defaulting-plugin-fail`, among others. Happily, this also nicely simplifies the implementation. Closes #21059. - - - - - 2a47ee9c by Daniel Gröber at 2022-02-10T19:18:58-05:00 ghc-boot: Simplify writePackageDb permissions handling Commit ef8a3fbf1 ("ghc-boot: Fix metadata handling of writeFileAtomic") introduced a somewhat over-engineered fix for #14017 by trying to preserve the current permissions if the target file already exists. The problem in the issue is simply that the package db cache file should be world readable but isn't if umask is too restrictive. In fact the previous fix only handles part of this problem. If the file isn't already there in a readable configuration it wont make it so which isn't really ideal either. Rather than all that we now simply always force all the read access bits to allow access while leaving the owner at the system default as it's just not our business to mess with it. - - - - - a1d97968 by Ben Gamari at 2022-02-10T19:19:34-05:00 Bump Cabal submodule Adapts GHC to the factoring-out of `Cabal-syntax`. Fixes #20991. Metric Decrease: haddock.Cabal - - - - - 89cf8caa by Morrow at 2022-02-10T19:20:13-05:00 Add metadata to integer-gmp.cabal - - - - - c995b7e7 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Fix event type of EVENT_IPE This leads to corrupted eventlogs because the size of EVENT_IPE is completely wrong. Fixes a bug introduced in 2e29edb7421c21902b47d130d45f60d3f584a0de - - - - - 59ba8fb3 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Fix event type of MEM_RETURN This leads to corrupted eventlogs because the size of EVENT_MEM_RETURN is completely wrong. Fixes a bug introduced in 2e29edb7421c21902b47d130d45f60d3f584a0de - - - - - 19413d09 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Delete misleading comment in gen_event_types.py Not all events start with CapNo and there's not logic I could see which adds this to the length. - - - - - e06f49c0 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Fix size of TICKY_COUNTER_BEGIN_SAMPLE - - - - - 2f99255b by Matthew Pickering at 2022-02-10T19:21:24-05:00 Fix copy-pasto in prof-late-ccs docs - - - - - 19deb002 by Matthew Pickering at 2022-02-10T19:21:59-05:00 Refine tcSemigroupWarnings to work in ghc-prim ghc-prim doesn't depend on base so can't have any Monoid or Semigroup instances. However, attempting to load these definitions ran into issues when the interface for `GHC.Base` did exist as that would try and load the interface for `GHC.Types` (which is the module we are trying to compile and has no interface). The fix is to just not do this check when we are compiling a module in ghc-prim. Fixes #21069 - - - - - 34dec6b7 by sheaf at 2022-02-11T17:55:34-05:00 Decrease the size of the LargeRecord test This test was taking too long to run, so this patch makes it smaller. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - 9cab90d9 by Matthew Pickering at 2022-02-11T22:27:19-05:00 Make sure all platforms have a release job The release bindists are currently a mixture of validate and release builds. This is bad because the validate builds don't have profiling libraries. The fix is to make sure there is a release job for each platform we want to produce a release for.t Fixes #21066 - - - - - 4bce3575 by Matthew Pickering at 2022-02-11T22:27:54-05:00 testsuite: Make sure all tests trigger ghc rebuild I made a mistake when implementing #21029 which meant that certain tests didn't trigger a GHC recompilation. By adding the `test:ghc` target to the default settings all tests will now depend on this target unless explicitly opting out via the no_deps modifier. - - - - - 90a26f8b by Sylvain Henry at 2022-02-11T22:28:34-05:00 Fix documentation about Word64Rep/Int64Rep (#16964) - - - - - 0e93023e by Andreas Klebinger at 2022-02-12T13:59:41+00:00 Tag inference work. This does three major things: * Enforce the invariant that all strict fields must contain tagged pointers. * Try to predict the tag on bindings in order to omit tag checks. * Allows functions to pass arguments unlifted (call-by-value). The former is "simply" achieved by wrapping any constructor allocations with a case which will evaluate the respective strict bindings. The prediction is done by a new data flow analysis based on the STG representation of a program. This also helps us to avoid generating redudant cases for the above invariant. StrictWorkers are created by W/W directly and SpecConstr indirectly. See the Note [Strict Worker Ids] Other minor changes: * Add StgUtil module containing a few functions needed by, but not specific to the tag analysis. ------------------------- Metric Decrease: T12545 T18698b T18140 T18923 LargeRecord Metric Increase: LargeRecord ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T15164 T18282 T18304 T18698a T1969 T20049 T3294 T4801 T5321FD T5321Fun T783 T9233 T9675 T9961 T19695 WWRec ------------------------- - - - - - 744f8a11 by Greg Steuck at 2022-02-12T17:13:55-05:00 Only check the exit code in derefnull & divbyzero tests on OpenBSD - - - - - eeead9fc by Ben Gamari at 2022-02-13T03:26:14-05:00 rts/Adjustor: Ensure that allocateExecPage succeeded Previously we failed to handle the case that `allocateExecPage` failed. - - - - - afdfaff0 by Ben Gamari at 2022-02-13T03:26:14-05:00 rts: Drop DEC Alpha adjustor implementation The last Alpha chip was produced in 2004. - - - - - 191dfd2d by Ben Gamari at 2022-02-13T03:26:14-05:00 rts/adjustor: Split Windows path out of NativeAmd64 - - - - - be591e27 by Ben Gamari at 2022-02-13T03:26:14-05:00 rts: Initial commit of AdjustorPool - - - - - d6d48b16 by Ben Gamari at 2022-02-13T03:26:14-05:00 Introduce initAdjustors - - - - - eab37902 by Ben Gamari at 2022-02-13T03:26:14-05:00 adjustors/NativeAmd64: Use AdjustorPool - - - - - 974e73af by Ben Gamari at 2022-02-13T03:26:14-05:00 adjustors/NativeAmd64Mingw: Use AdjustorPool - - - - - 95fab83f by Ben Gamari at 2022-02-13T03:26:14-05:00 configure: Fix result reporting of adjustors method check - - - - - ef5cf55d by nikshalark at 2022-02-13T03:26:16-05:00 (#21044) Documented arithmetic functions in base. Didn't get it right the ninth time. Now everything's formatted correctly. - - - - - acb482cc by Takenobu Tani at 2022-02-16T05:27:17-05:00 Relax load_load_barrier for aarch64 This patch relaxes the instruction for load_load_barrier(). Current load_load_barrier() implements full-barrier with `dmb sy`. It's too strong to order load-load instructions. We can relax it by using `dmb ld`. If current load_load_barrier() is used for full-barriers (load/store - load/store barrier), this patch is not suitable. See also linux-kernel's smp_rmb() implementation: https://github.com/torvalds/linux/blob/v5.14/arch/arm64/include/asm/barrier.h#L90 Hopefully, it's better to use `dmb ishld` rather than `dmb ld` to improve performance. However, I can't validate effects on a real many-core Arm machine. - - - - - 84eaa26f by Oleg Grenrus at 2022-02-16T05:27:56-05:00 Add test for #20562 - - - - - 2c28620d by Adam Sandberg Ericsson at 2022-02-16T05:28:32-05:00 rts: remove struct StgRetry, it is never used - - - - - 74bf9bb5 by Adam Sandberg Ericsson at 2022-02-16T05:28:32-05:00 rts: document some closure types - - - - - 316312ec by nineonine at 2022-02-16T05:29:08-05:00 ghci: fix -ddump-stg-cg (#21052) The pre-codegen Stg AST dump was not available in ghci because it was performed in 'doCodeGen'. This was now moved to 'coreToStg' area. - - - - - a6411d74 by Adam Sandberg Ericsson at 2022-02-16T05:29:43-05:00 docs: mention -fprof-late-ccs in the release notes And note which compiler version it was added in. - - - - - 4127e86d by Adam Sandberg Ericsson at 2022-02-16T05:29:43-05:00 docs: fix release notes formatting - - - - - 4e6c8019 by Matthew Pickering at 2022-02-17T05:25:28-05:00 Always define __GLASGOW_HASKELL_PATCHLEVEL1/2__ macros As #21076 reports if you are using `-Wcpp-undef` then you get warnings when using the `MIN_VERSION_GLASGOW_HASKELL` macro because __GLASGOW_HASKELL_PATCHLEVEL2__ is very rarely explicitliy set (as version numbers are not 4 components long). This macro was introduced in 3549c952b535803270872adaf87262f2df0295a4 and it seems the bug has existed ever since. Fixes #21076 - - - - - 67dd5724 by Ben Gamari at 2022-02-17T05:26:03-05:00 rts/AdjustorPool: Silence unused function warning bitmap_get is only used in the DEBUG RTS configuration. Fixes #21079. - - - - - 4b04f7e1 by Zubin Duggal at 2022-02-20T13:56:15-05:00 Track object file dependencies for TH accurately (#20604) `hscCompileCoreExprHook` is changed to return a list of `Module`s required by a splice. These modules are accumulated in the TcGblEnv (tcg_th_needed_mods). Dependencies on the object files of these modules are recording in the interface. The data structures in `LoaderState` are replaced with more efficient versions to keep track of all the information required. The MultiLayerModulesTH_Make allocations increase slightly but runtime is faster. Fixes #20604 ------------------------- Metric Increase: MultiLayerModulesTH_Make ------------------------- - - - - - 92ab3ff2 by sheaf at 2022-02-20T13:56:55-05:00 Use diagnostics for "missing signature" errors This patch makes the "missing signature" errors from "GHC.Rename.Names" use the diagnostic infrastructure. This encompasses missing type signatures for top-level bindings and pattern synonyms, as well as missing kind signatures for type constructors. This patch also renames TcReportMsg to TcSolverReportMsg, and adds a few convenience functions to compute whether such a TcSolverReportMsg is an expected/actual message. - - - - - 845284a5 by sheaf at 2022-02-20T13:57:34-05:00 Generically: remove redundant Semigroup constraint This patch removes a redundant Semigroup constraint on the Monoid instance for Generically. This constraint can cause trouble when one wants to derive a Monoid instance via Generically through a type that doesn't itself have a Semigroup instance, for example: data Point2D a = Point2D !a !a newtype Vector2D a = Vector2D { tip :: Point2D a } deriving ( Semigroup, Monoid ) via Generically ( Point2D ( Sum a ) ) In this case, we should not require there to be an instance Semigroup ( Point2D ( Sum a ) ) as all we need is an instance for the generic representation of Point2D ( Sum a ), i.e. Semigroup ( Rep ( Point2D ( Sum a) ) () ). - - - - - 6b468f7f by Ben Gamari at 2022-02-20T13:58:10-05:00 Bump time submodule to 1.12.1 - - - - - 2f0ceecc by Zubin Duggal at 2022-02-20T19:06:19+00:00 hadrian: detect if 'main' is not a haskell file and add it to appropriate list of sources - - - - - 7ce1b694 by Zubin Duggal at 2022-02-21T11:18:58+00:00 Reinstallable GHC This patch allows ghc and its dependencies to be built using a normal invocation of cabal-install. Each componenent which relied on generated files or additional configuration now has a Setup.hs file. There are also various fixes to the cabal files to satisfy cabal-install. There is a new hadrian command which will build a stage2 compiler and then a stage3 compiler by using cabal. ``` ./hadrian/build build-cabal ``` There is also a new CI job which tests running this command. For the 9.4 release we will upload all the dependent executables to hackage and then end users will be free to build GHC and GHC executables via cabal. There are still some unresolved questions about how to ensure soundness when loading plugins into a reinstalled GHC (#20742) which will be tighted up in due course. Fixes #19896 - - - - - 78fbc3a3 by Matthew Pickering at 2022-02-21T15:14:28-05:00 hadrian: Enable late-ccs when building profiled_ghc - - - - - 2b890c89 by Matthew Pickering at 2022-02-22T15:59:33-05:00 testsuite: Don't print names of all fragile tests on all runs This information about fragile tests is pretty useless but annoying on CI where you have to scroll up a long way to see the actual issues. - - - - - 0b36801f by sheaf at 2022-02-22T16:00:14-05:00 Forbid standalone instances for built-in classes `check_special_inst_head` includes logic that disallows hand-written instances for built-in classes such as Typeable, KnownNat and KnownSymbol. However, it also allowed standalone deriving declarations. This was because we do want to allow standalone deriving instances with Typeable as they are harmless, but we certainly don't want to allow instances for e.g. KnownNat. This patch ensures that we don't allow derived instances for KnownNat, KnownSymbol (and also KnownChar, which was previously omitted entirely). Fixes #21087 - - - - - ace66dec by Krzysztof Gogolewski at 2022-02-22T16:30:59-05:00 Remove -Wunticked-promoted-constructors from -Wall Update manual; explain ticks as optional disambiguation rather than the preferred default. This is a part of #20531. - - - - - 558c7d55 by Hugo at 2022-02-22T16:31:01-05:00 docs: fix error in annotation guide code snippet - - - - - a599abba by Richard Eisenberg at 2022-02-23T08:16:07-05:00 Kill derived constraints Co-authored by: Sam Derbyshire Previously, GHC had three flavours of constraint: Wanted, Given, and Derived. This removes Derived constraints. Though serving a number of purposes, the most important role of Derived constraints was to enable better error messages. This job has been taken over by the new RewriterSets, as explained in Note [Wanteds rewrite wanteds] in GHC.Tc.Types.Constraint. Other knock-on effects: - Various new Notes as I learned about under-described bits of GHC - A reshuffling around the AST for implicit-parameter bindings, with better integration with TTG. - Various improvements around fundeps. These were caused by the fact that, previously, fundep constraints were all Derived, and Derived constraints would get dropped. Thus, an unsolved Derived didn't stop compilation. Without Derived, this is no longer possible, and so we have to be considerably more careful around fundeps. - A nice little refactoring in GHC.Tc.Errors to center the work on a new datatype called ErrorItem. Constraints are converted into ErrorItems at the start of processing, and this allows for a little preprocessing before the main classification. - This commit also cleans up the behavior in generalisation around functional dependencies. Now, if a variable is determined by functional dependencies, it will not be quantified. This change is user facing, but it should trim down GHC's strange behavior around fundeps. - Previously, reportWanteds did quite a bit of work, even on an empty WantedConstraints. This commit adds a fast path. - Now, GHC will unconditionally re-simplify constraints during quantification. See Note [Unconditionally resimplify constraints when quantifying], in GHC.Tc.Solver. Close #18398. Close #18406. Solve the fundep-related non-confluence in #18851. Close #19131. Close #19137. Close #20922. Close #20668. Close #19665. ------------------------- Metric Decrease: LargeRecord T9872b T9872b_defer T9872d TcPlugin_RewritePerf ------------------------- - - - - - 2ed22ba1 by Matthew Pickering at 2022-02-23T08:16:43-05:00 Introduce predicate for when to enable source notes (needSourceNotes) There were situations where we were using debugLevel == 0 as a proxy for whether to retain source notes but -finfo-table-map also enables and needs source notes so we should act consistently in both cases. Ticket #20847 - - - - - 37deb893 by Matthew Pickering at 2022-02-23T08:16:43-05:00 Use SrcSpan from the binder as initial source estimate There are some situations where we end up with no source notes in useful positions in an expression. In this case we currently fail to provide any source information about where an expression came from. This patch improves the initial estimate by using the position from the top-binder as the guess for the location of the whole inner expression. It provides quite a course estimate but it's better than nothing. Ticket #20847 - - - - - 59b7f764 by Cheng Shao at 2022-02-23T08:17:24-05:00 Don't emit foreign exports initialiser code for empty CAF list - - - - - c7f32f76 by John Ericson at 2022-02-23T13:58:36-05:00 Prepare rechecking logic for new type in a few ways Combine `MustCompile and `NeedsCompile` into a single case. `CompileReason` is put inside to destinguish the two. This makes a number of things easier. `Semigroup RecompileRequired` is no longer used, to make sure we skip doing work where possible. `recompThen` is very similar, but helps remember. `checkList` is rewritten with `recompThen`. - - - - - e60d8df8 by John Ericson at 2022-02-23T13:58:36-05:00 Introduce `MaybeValidated` type to remove invalid states The old return type `(RecompRequired, Maybe _)`, was confusing because it was inhabited by values like `(UpToDate, Nothing)` that made no sense. The new type ensures: - you must provide a value if it is up to date. - you must provide a reason if you don't provide a value. it is used as the return value of: - `checkOldIface` - `checkByteCode` - `checkObjects` - - - - - f07b13e3 by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: refactor X86 codegen Preliminary work done to make working on #5444 easier. Mostly make make control-flow easier to follow: * renamed genCCall into genForeignCall * split genForeignCall into the part dispatching on PrimTarget (genPrim) and the one really generating code for a C call (cf ForeignTarget and genCCall) * made genPrim/genSimplePrim only dispatch on MachOp: each MachOp now has its own code generation function. * out-of-line primops are not handled in a partial `outOfLineCmmOp` anymore but in the code generation functions directly. Helper functions have been introduced (e.g. genLibCCall) for code sharing. * the latter two bullets make code generated for primops that are only sometimes out-of-line (e.g. Pdep or Memcpy) and the logic to select between inline/out-of-line much more localized * avoided passing is32bit as an argument as we can easily get it from NatM state when we really need it * changed genCCall type to avoid it being partial (it can't handle PrimTarget) * globally removed 12 calls to `panic` thanks to better control flow and types ("parse, don't validate" ftw!). - - - - - 6fa7591e by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: refactor the way registers are handled * add getLocalRegReg to avoid allocating a CmmLocal just to call getRegisterReg * 64-bit registers: in the general case we must always use the virtual higher part of the register, so we might as well always return it with the lower part. The only exception is to implement 64-bit to 32-bit conversions. We now have to explicitly discard the higher part when matching on Reg64/RegCode64 datatypes instead of explicitly fetching the higher part from the lower part: much safer default. - - - - - bc8de322 by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: inline some 64-bit primops on x86/32-bit (#5444) Several 64-bit operation were implemented with FFI calls on 32-bit architectures but we can easily implement them with inline assembly code. Also remove unused hs_int64ToWord64 and hs_word64ToInt64 C functions. - - - - - 7b7c6b95 by Matthew Pickering at 2022-02-23T14:00:00-05:00 Simplify/correct implementation of getModuleInfo - - - - - 6215b04c by Matthew Pickering at 2022-02-23T14:00:00-05:00 Remove mg_boot field from ModuleGraph It was unused in the compiler so I have removed it to streamline ModuleGraph. - - - - - 818ff2ef by Matthew Pickering at 2022-02-23T14:00:01-05:00 driver: Remove needsTemplateHaskellOrQQ from ModuleGraph The idea of the needsTemplateHaskellOrQQ query is to check if any of the modules in a module graph need Template Haskell then enable -dynamic-too if necessary. This is quite imprecise though as it will enable -dynamic-too for all modules in the module graph even if only one module uses template haskell, with multiple home units, this is obviously even worse. With -fno-code we already have similar logic to enable code generation just for the modules which are dependeded on my TemplateHaskell modules so we use the same code path to decide whether to enable -dynamic-too rather than using this big hammer. This is part of the larger overall goal of moving as much statically known configuration into the downsweep as possible in order to have fully decided the build plan and all the options before starting to build anything. I also included a fix to #21095, a long standing bug with with the logic which is supposed to enable the external interpreter if we don't have the internal interpreter. Fixes #20696 #21095 - - - - - b6670af6 by Matthew Pickering at 2022-02-23T14:00:40-05:00 testsuite: Normalise output of ghci011 and T7627 The outputs of these tests vary on the order interface files are loaded so we normalise the output to correct for these inconsequential differences. Fixes #21121 - - - - - 9ed3bc6e by Peter Trommler at 2022-02-23T14:01:16-05:00 testsuite: Fix ipeMap test Pointers to closures must be untagged before use. Produce closures of different types so we get different info tables. Fixes #21112 - - - - - 7d426148 by Ziyang Liu at 2022-02-24T04:53:34-05:00 Allow `return` in more cases in ApplicativeDo The doc says that the last statement of an ado-block can be one of `return E`, `return $ E`, `pure E` and `pure $ E`. But `return` is not accepted in a few cases such as: ```haskell -- The ado-block only has one statement x :: F () x = do return () -- The ado-block only has let-statements besides the `return` y :: F () y = do let a = True return () ``` These currently require `Monad` instances. This MR fixes it. Normally `return` is accepted as the last statement because it is stripped in constructing an `ApplicativeStmt`, but this cannot be done in the above cases, so instead we replace `return` by `pure`. A similar but different issue (when the ado-block contains `BindStmt` or `BodyStmt`, the second last statement cannot be `LetStmt`, even if the last statement uses `pure`) is fixed in !6786. - - - - - a5ea7867 by John Ericson at 2022-02-24T20:23:49-05:00 Clarify laws of TestEquality It is unclear what `TestEquality` is for. There are 3 possible choices. Assuming ```haskell data Tag a where TagInt1 :: Tag Int TagInt2 :: Tag Int ``` Weakest -- type param equality semi-decidable --------------------------------------------- `Just Refl` merely means the type params are equal, the values being compared might not be. `Nothing` means the type params may or may not be not equal. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Nothing -- oopsie is allowed testEquality TagInt1 TagInt2 = Just Refl testEquality TagInt2 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl ``` This option is better demonstrated with a different type: ```haskell data Tag' a where TagInt1 :: Tag Int TagInt2 :: Tag a ``` ```haskell instance TestEquality Tag' where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt1 TagInt2 = Nothing -- can't be sure testEquality TagInt2 TagInt1 = Nothing -- can't be sure testEquality TagInt2 TagInt2 = Nothing -- can't be sure ``` Weaker -- type param equality decidable --------------------------------------- `Just Refl` merely means the type params are equal, the values being compared might not be. `Nothing` means the type params are not equal. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt1 TagInt2 = Just Refl testEquality TagInt2 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl ``` Strong -- Like `Eq` ------------------- `Just Refl` means the type params are equal, and the values are equal according to `Eq`. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl testEquality _ _ = Nothing ``` Strongest -- unique value concrete type --------------------------------------- `Just Refl` means the type params are equal, and the values are equal, and the class assume if the type params are equal the values must also be equal. In other words, the type is a singleton type when the type parameter is a closed term. ```haskell -- instance TestEquality -- invalid instance because two variants for `Int` ``` ------ The discussion in https://github.com/haskell/core-libraries-committee/issues/21 has decided on the "Weaker" option (confusingly formerly called the "Weakest" option). So that is what is implemented. - - - - - 06c18990 by Zubin Duggal at 2022-02-24T20:24:25-05:00 TH: fix pretty printing of GADTs with multiple constuctors (#20842) - - - - - 6555b68c by Matthew Pickering at 2022-02-24T20:25:06-05:00 Move linters into the tree This MR moves the GHC linters into the tree, so that they can be run directly using Hadrian. * Query all files tracked by Git instead of using changed files, so that we can run the exact same linting step locally and in a merge request. * Only check that the changelogs don't contain TBA when RELEASE=YES. * Add hadrian/lint script, which runs all the linting steps. * Ensure the hlint job exits with a failure if hlint is not installed (otherwise we were ignoring the failure). Given that hlint doesn't seem to be available in CI at the moment, I've temporarily allowed failure in the hlint job. * Run all linting tests in CI using hadrian. - - - - - b99646ed by Matthew Pickering at 2022-02-24T20:25:06-05:00 Add rule for generating HsBaseConfig.h If you are running the `lint:{base/compiler}` command locally then this improves the responsiveness because we don't re-run configure everytime if the header file already exists. - - - - - d0deaaf4 by Matthew Pickering at 2022-02-24T20:25:06-05:00 Suggestions due to hlint It turns out this job hasn't been running for quite a while (perhaps ever) so there are quite a few failures when running the linter locally. - - - - - 70bafefb by nineonine at 2022-02-24T20:25:42-05:00 ghci: show helpful error message when loading module with SIMD vector operations (#20214) Previously, when trying to load module with SIMD vector operations, ghci would panic in 'GHC.StgToByteCode.findPushSeq'. Now, a more helpful message is displayed. - - - - - 8ed3d5fd by Matthew Pickering at 2022-02-25T10:24:12+00:00 Remove test-bootstrap and cabal-reinstall jobs from fast-ci [skip ci] - - - - - 8387dfbe by Mario Blažević at 2022-02-25T21:09:41-05:00 template-haskell: Fix two prettyprinter issues Fix two issues regarding printing numeric literals. Fixing #20454. - - - - - 4ad8ce0b by sheaf at 2022-02-25T21:10:22-05:00 GHCi: don't normalise partially instantiated types This patch skips performing type normalisation when we haven't fully instantiated the type. That is, in tcRnExpr (used only for :type in GHCi), skip normalisation if the result type responds True to isSigmaTy. Fixes #20974 - - - - - f35aca4d by Ben Gamari at 2022-02-25T21:10:57-05:00 rts/adjustor: Always place adjustor templates in data section @nrnrnr points out that on his machine ld.lld rejects text relocations. Generalize the Darwin text-relocation avoidance logic to account for this. - - - - - cddb040a by Andreas Klebinger at 2022-02-25T21:11:33-05:00 Ticky: Gate tag-inference dummy ticky-counters behind a flag. Tag inference included a way to collect stats about avoided tag-checks. This was dony by emitting "dummy" ticky entries with counts corresponding to predicted/unpredicated tag checks. This behaviour for ticky is now gated behind -fticky-tag-checks. I also documented ticky-LNE in the process. - - - - - 948bf2d0 by Ben Gamari at 2022-02-25T21:12:09-05:00 Fix comment reference to T4818 - - - - - 9c3edeb8 by Ben Gamari at 2022-02-25T21:12:09-05:00 simplCore: Correctly extend in-scope set in rule matching Note [Matching lets] in GHC.Core.Rules claims the following: > We use GHC.Core.Subst.substBind to freshen the binding, using an > in-scope set that is the original in-scope variables plus the > rs_bndrs (currently floated let-bindings). However, previously the implementation didn't actually do extend the in-scope set with rs_bndrs. This appears to be a regression which was introduced by 4ff4d434e9a90623afce00b43e2a5a1ccbdb4c05. Moreover, the originally reasoning was subtly wrong: we must rather use the in-scope set from rv_lcl, extended with rs_bndrs, not that of `rv_fltR` Fixes #21122. - - - - - 7f9f49c3 by sheaf at 2022-02-25T21:12:47-05:00 Derive some stock instances for OverridingBool This patch adds some derived instances to `GHC.Data.Bool.OverridingBool`. It also changes the order of the constructors, so that the derived `Ord` instance matches the behaviour for `Maybe Bool`. Fixes #20326 - - - - - 140438a8 by nineonine at 2022-02-25T21:13:23-05:00 Add test for #19271 - - - - - ac9f4606 by sheaf at 2022-02-25T21:14:04-05:00 Allow qualified names in COMPLETE pragmas The parser didn't allow qualified constructor names to appear in COMPLETE pragmas. This patch fixes that. Fixes #20551 - - - - - 677c6c91 by Sylvain Henry at 2022-02-25T21:14:44-05:00 Testsuite: remove arch conditional in T8832 Taken from !3658 - - - - - ad04953b by Sylvain Henry at 2022-02-25T21:15:23-05:00 Allow hscGenHardCode to not return CgInfos This is a minor change in preparation for the JS backend: CgInfos aren't mandatory and the JS backend won't return them. - - - - - 929c280f by Sylvain Henry at 2022-02-25T21:15:24-05:00 Derive Enum instances for CCallConv and Safety This is used by the JS backend for serialization. - - - - - 75e4e090 by Sebastian Graf at 2022-02-25T21:15:59-05:00 base: Improve documentation of `throwIO` (#19854) Now it takes a better account of precise vs. imprecise exception semantics. Fixes #19854. - - - - - 61a203ba by Matthew Pickering at 2022-02-26T02:06:51-05:00 Make typechecking unfoldings from interfaces lazier The old logic was unecessarily strict in loading unfoldings because when reading the unfolding we would case on the result of attempting to load the template before commiting to which type of unfolding we were producing. Hence trying to inspect any of the information about an unfolding would force the template to be loaded. This also removes a potentially hard to discover bug where if the template failed to be typechecked for some reason then we would just not return an unfolding. Instead we now panic so these bad situations which should never arise can be identified. - - - - - 2be74460 by Matthew Pickering at 2022-02-26T02:06:51-05:00 Use a more up-to-date snapshot of the current rules in the simplifier As the prescient (now deleted) note warns in simplifyPgmIO we have to be a bit careful about when we gather rules from the EPS so that we get the rules for imported bindings. ``` -- Get any new rules, and extend the rule base -- See Note [Overall plumbing for rules] in GHC.Core.Rules -- We need to do this regularly, because simplification can -- poke on IdInfo thunks, which in turn brings in new rules -- behind the scenes. Otherwise there's a danger we'll simply -- miss the rules for Ids hidden inside imported inlinings ``` Given the previous commit, the loading of unfoldings is now even more delayed so we need to be more careful to read the EPS rule base closer to the point where we decide to try rules. Without this fix GHC performance regressed by a noticeably amount because the `zip` rule was not brought into scope eagerly enough which led to a further series of unfortunate events in the simplifer which tipped `substTyWithCoVars` over the edge of the size threshold, stopped it being inlined and increased allocations by 10% in some cases. Furthermore, this change is noticeably in the testsuite as it changes T19790 so that the `length` rules from GHC.List fires earlier. ------------------------- Metric Increase: T9961 ------------------------- - - - - - b8046195 by Matthew Pickering at 2022-02-26T02:06:52-05:00 Improve efficiency of extending a RuleEnv with a new RuleBase Essentially we apply the identity: > lookupNameEnv n (plusNameEnv_C (++) rb1 rb2) > = lookupNameEnv n rb1 ++ lookupNameEnv n rb2 The latter being more efficient as we don't construct an intermediate map. This is now quite important as each time we try and apply rules we need to combine the current EPS RuleBase with the HPT and ModGuts rule bases. - - - - - 033e9f0f by sheaf at 2022-02-26T02:07:30-05:00 Error on anon wildcards in tcAnonWildCardOcc The code in tcAnonWildCardOcc assumed that it could never encounter anonymous wildcards in illegal positions, because the renamer would have ruled them out. However, it's possible to sneak past the checks in the renamer by using Template Haskell. It isn't possible to simply pass on additional information when renaming Template Haskell brackets, because we don't know in advance in what context the bracket will be spliced in (see test case T15433b). So we accept that we might encounter these bogus wildcards in the typechecker and throw the appropriate error. This patch also migrates the error messages for illegal wildcards in types to use the diagnostic infrastructure. Fixes #15433 - - - - - 32d8fe3a by sheaf at 2022-02-26T14:15:33+01:00 Core Lint: ensure primops can be eta-expanded This patch adds a check to Core Lint, checkCanEtaExpand, which ensures that primops and other wired-in functions with no binding such as unsafeCoerce#, oneShot, rightSection... can always be eta-expanded, by checking that the remaining argument types have a fixed RuntimeRep. Two subtleties came up: - the notion of arity in Core looks through newtypes, so we may need to unwrap newtypes in this check, - we want to avoid calling hasNoBinding on something whose unfolding we are in the process of linting, as this would cause a loop; to avoid this we add some information to the Core Lint environment that holds this information. Fixes #20480 - - - - - 0a80b436 by Peter Trommler at 2022-02-26T17:21:59-05:00 testsuite: Require LLVM for T15155l - - - - - 38cb920e by Oleg Grenrus at 2022-02-28T07:14:04-05:00 Add Monoid a => Monoid (STM a) instance - - - - - d734ef8f by Hécate Moonlight at 2022-02-28T07:14:42-05:00 Make modules in base stable. fix #18963 - - - - - fbf005e9 by Sven Tennie at 2022-02-28T19:16:01-05:00 Fix some hlint issues in ghc-heap This does not fix all hlint issues as the criticised index and length expressions seem to be fine in context. - - - - - adfddf7d by Matthew Pickering at 2022-02-28T19:16:36-05:00 hadrian: Suggest to the user to run ./configure if missing a setting If a setting is missing from the configuration file it's likely the user needs to reconfigure. Fixes #20476 - - - - - 4f0208e5 by Andreas Klebinger at 2022-02-28T19:17:12-05:00 CLabel cleanup: Remove these smart constructors for these reasons: * mkLocalClosureTableLabel : Does the same as the non-local variant. * mkLocalClosureLabel : Does the same as the non-local variant. * mkLocalInfoTableLabel : Decide if we make a local label based on the name and just use mkInfoTableLabel everywhere. - - - - - 065419af by Matthew Pickering at 2022-02-28T19:17:47-05:00 linking: Don't pass --hash-size and --reduce-memory-overhead to ld These flags were added to help with the high linking cost of the old split-objs mode. Now we are using split-sections these flags appear to make no difference to memory usage or time taken to link. I tested various configurations linking together the ghc library with -split-sections enabled. | linker | time (s) | | ------ | ------ | | gold | 0.95 | | ld | 1.6 | | ld (hash-size = 31, reduce-memory-overheads) | 1.6 | | ldd | 0.47 | Fixes #20967 - - - - - 3e65ef05 by Teo Camarasu at 2022-02-28T19:18:27-05:00 template-haskell: fix typo in docstring for Overlap - - - - - 80f9133e by Teo Camarasu at 2022-02-28T19:18:27-05:00 template-haskell: fix docstring for Bytes It seems like a commented out section of code was accidentally included in the docstring for a field. - - - - - 54774268 by Matthew Pickering at 2022-03-01T16:23:10-05:00 Fix longstanding issue with moduleGraphNodes - no hs-boot files case In the case when we tell moduleGraphNodes to drop hs-boot files the idea is to collapse hs-boot files into their hs file nodes. In the old code * nodeDependencies changed edges from IsBoot to NonBoot * moduleGraphNodes just dropped boot file nodes The net result is that any dependencies of the hs-boot files themselves were dropped. The correct thing to do is * nodeDependencies changes edges from IsBoot to NonBoot * moduleGraphNodes merges dependencies of IsBoot and NonBoot nodes. The result is a properly quotiented dependency graph which contains no hs-boot files nor hs-boot file edges. Why this didn't cause endless issues when compiling with boot files, we will never know. - - - - - c84dc506 by Matthew Pickering at 2022-03-01T16:23:10-05:00 driver: Properly add an edge between a .hs and its hs-boot file As noted in #21071 we were missing adding this edge so there were situations where the .hs file would get compiled before the .hs-boot file which leads to issues with -j. I fixed this properly by adding the edge in downsweep so the definition of nodeDependencies can be simplified to avoid adding this dummy edge in. There are plenty of tests which seem to have these redundant boot files anyway so no new test. #21094 tracks the more general issue of identifying redundant hs-boot and SOURCE imports. - - - - - 7aeb6d29 by sheaf at 2022-03-01T16:23:51-05:00 Core Lint: collect args through floatable ticks We were not looking through floatable ticks when collecting arguments in Core Lint, which caused `checkCanEtaExpand` to fail on something like: ```haskell reallyUnsafePtrEquality = \ @a -> (src<loc> reallyUnsafePtrEquality#) @Lifted @a @Lifted @a ``` We fix this by using `collectArgsTicks tickishFloatable` instead of `collectArgs`, to be consistent with the behaviour of eta expansion outlined in Note [Eta expansion and source notes] in GHC.Core.Opt.Arity. Fixes #21152. - - - - - 75caafaa by Matthew Pickering at 2022-03-02T01:14:59-05:00 Ticky profiling improvements. This adds a number of changes to ticky-ticky profiling. When an executable is profiled with IPE profiling it's now possible to associate id-related ticky counters to their source location. This works by emitting the info table address as part of the counter which can be looked up in the IPE table. Add a `-ticky-ap-thunk` flag. This flag prevents the use of some standard thunks which are precompiled into the RTS. This means reduced cache locality and increased code size. But it allows better attribution of execution cost to specific source locations instead of simple attributing it to the standard thunk. ticky-ticky now uses the `arg` field to emit additional information about counters in json format. When ticky-ticky is used in combination with the eventlog eventlog2html can be used to generate a html table from the eventlog similar to the old text output for ticky-ticky. - - - - - aeea6bd5 by doyougnu at 2022-03-02T01:15:39-05:00 StgToCmm.cgTopBinding: no isNCG, use binBlobThresh This is a one line change. It is a fixup from MR!7325, was pointed out in review of MR!7442, specifically: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7442#note_406581 The change removes isNCG check from cgTopBinding. Instead it changes the type of binBlobThresh in DynFlags from Word to Maybe Word, where a Just 0 or a Nothing indicates an infinite threshold and thus the disable CmmFileEmbed case in the original check. This improves the cohesion of the module because more NCG related Backend stuff is moved into, and checked in, StgToCmm.Config. Note, that the meaning of a Just 0 or a Nothing in binBlobThresh is indicated in a comment next to its field in GHC.StgToCmm.Config. DynFlags: binBlobThresh: Word -> Maybe Word StgToCmm.Config: binBlobThesh add not ncg check DynFlags.binBlob: move Just 0 check to dflags init StgToCmm.binBlob: only check isNCG, Just 0 check to dflags StgToCmm.Config: strictify binBlobThresh - - - - - b27b2af3 by sheaf at 2022-03-02T14:08:36-05:00 Introduce ConcreteTv metavariables This patch introduces a new kind of metavariable, by adding the constructor `ConcreteTv` to `MetaInfo`. A metavariable with `ConcreteTv` `MetaInfo`, henceforth a concrete metavariable, can only be unified with a type that is concrete (that is, a type that answers `True` to `GHC.Core.Type.isConcrete`). This solves the problem of dangling metavariables in `Concrete#` constraints: instead of emitting `Concrete# ty`, which contains a secret existential metavariable, we simply emit a primitive equality constraint `ty ~# concrete_tv` where `concrete_tv` is a fresh concrete metavariable. This means we can avoid all the complexity of canonicalising `Concrete#` constraints, as we can just re-use the existing machinery for `~#`. To finish things up, this patch then removes the `Concrete#` special predicate, and instead introduces the special predicate `IsRefl#` which enforces that a coercion is reflexive. Such a constraint is needed because the canonicaliser is quite happy to rewrite an equality constraint such as `ty ~# concrete_tv`, but such a rewriting is not handled by the rest of the compiler currently, as we need to make use of the resulting coercion, as outlined in the FixedRuntimeRep plan. The big upside of this approach (on top of simplifying the code) is that we can now selectively implement PHASE 2 of FixedRuntimeRep, by changing individual calls of `hasFixedRuntimeRep_MustBeRefl` to `hasFixedRuntimeRep` and making use of the obtained coercion. - - - - - 81b7c436 by Matthew Pickering at 2022-03-02T14:09:13-05:00 Make -dannot-lint not panic on let bound type variables After certain simplifier passes we end up with let bound type variables which are immediately inlined in the next pass. The core diff utility implemented by -dannot-lint failed to take these into account and paniced. Progress towards #20965 - - - - - f596c91a by sheaf at 2022-03-02T14:09:51-05:00 Improve out-of-order inferred type variables Don't instantiate type variables for :type in `GHC.Tc.Gen.App.tcInstFun`, to avoid inconsistently instantianting `r1` but not `r2` in the type forall {r1} (a :: TYPE r1) {r2} (b :: TYPE r2). ... This fixes #21088. This patch also changes the primop pretty-printer to ensure that we put all the inferred type variables first. For example, the type of reallyUnsafePtrEquality# is now forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> Int# This means we avoid running into issue #21088 entirely with the types of primops. Users can still write a type signature where the inferred type variables don't come first, however. This change to primops had a knock-on consequence, revealing that we were sometimes performing eta reduction on keepAlive#. This patch updates tryEtaReduce to avoid eta reducing functions with no binding, bringing it in line with tryEtaReducePrep, and thus fixing #21090. - - - - - 1617fed3 by Richard Eisenberg at 2022-03-02T14:10:28-05:00 Make inert_cycle_breakers into a stack. Close #20231. - - - - - c8652a0a by Richard Eisenberg at 2022-03-02T14:11:03-05:00 Make Constraint not *apart* from Type. More details in Note [coreView vs tcView] Close #21092. - - - - - 91a10cb0 by doyougnu at 2022-03-02T14:11:43-05:00 GenStgAlt 3-tuple synonym --> Record type This commit alters GenStgAlt from a type synonym to a Record with field accessors. In pursuit of #21078, this is not a required change but cleans up several areas for nicer code in the upcoming js-backend, and in GHC itself. GenStgAlt: 3-tuple -> record Stg.Utils: GenStgAlt 3-tuple -> record Stg.Stats: StgAlt 3-tuple --> record Stg.InferTags.Rewrite: StgAlt 3-tuple -> record Stg.FVs: GenStgAlt 3-tuple -> record Stg.CSE: GenStgAlt 3-tuple -> record Stg.InferTags: GenStgAlt 3-tuple --> record Stg.Debug: GenStgAlt 3-tuple --> record Stg.Lift.Analysis: GenStgAlt 3-tuple --> record Stg.Lift: GenStgAlt 3-tuple --> record ByteCode.Instr: GenStgAlt 3-tuple --> record Stg.Syntax: add GenStgAlt helper functions Stg.Unarise: GenStgAlt 3-tuple --> record Stg.BcPrep: GenStgAlt 3-tuple --> record CoreToStg: GenStgAlt 3-tuple --> record StgToCmm.Expr: GenStgAlt 3-tuple --> record StgToCmm.Bind: GenStgAlt 3-tuple --> record StgToByteCode: GenStgAlt 3-tuple --> record Stg.Lint: GenStgAlt 3-tuple --> record Stg.Syntax: strictify GenStgAlt GenStgAlt: add haddock, some cleanup fixup: remove calls to pure, single ViewPattern StgToByteCode: use case over viewpatterns - - - - - 73864f00 by Matthew Pickering at 2022-03-02T14:12:19-05:00 base: Remove default method from bitraversable The default instance leads to an infinite loop. bisequenceA is defined in terms of bisquence which is defined in terms of bitraverse. ``` bitraverse f g = (defn of bitraverse) bisequenceA . bimap f g = (defn of bisequenceA) bitraverse id id . bimap f g = (defn of bitraverse) ... ``` Any instances defined without an explicitly implementation are currently broken, therefore removing it will alert users to an issue in their code. CLC issue: https://github.com/haskell/core-libraries-committee/issues/47 Fixes #20329 #18901 - - - - - 9579bf35 by Matthew Pickering at 2022-03-02T14:12:54-05:00 ci: Add check to CI to ensure compiler uses correct BIGNUM_BACKEND - - - - - c48a7c3a by Sylvain Henry at 2022-03-03T07:37:12-05:00 Use Word64# primops in Word64 Num instance Taken froù!3658 - - - - - ce65d0cc by Matthew Pickering at 2022-03-03T07:37:48-05:00 hadrian: Correctly set whether we have a debug compiler when running tests For example, running the `slow-validate` flavour would incorrectly run the T16135 test which would fail with an assertion error, despite the fact that is should be skipped when we have a debug compiler. - - - - - e0c3e757 by Matthew Pickering at 2022-03-03T13:48:41-05:00 docs: Add note to unsafeCoerce function that you might want to use coerce [skip ci] Fixes #15429 - - - - - 559d4cf3 by Matthew Pickering at 2022-03-03T13:49:17-05:00 docs: Add note to RULES documentation about locally bound variables [skip ci] Fixes #20100 - - - - - c534b3dd by Matthew Pickering at 2022-03-03T13:49:53-05:00 Replace ad-hoc CPP with constant from GHC.Utils.Constant Fixes #21154 - - - - - de56cc7e by Krzysztof Gogolewski at 2022-03-04T12:44:26-05:00 Update documentation of LiberalTypeSynonyms We no longer require LiberalTypeSynonyms to use 'forall' or an unboxed tuple in a synonym. I also removed that kind checking before expanding synonyms "could be changed". This was true when type synonyms were thought of macros, but with the extensions such as SAKS or matchability I don't see it changing. - - - - - c0a39259 by Simon Jakobi at 2022-03-04T12:45:01-05:00 base: Mark GHC.Bits not-home for haddock Most (all) of the exports are re-exported from the preferable Data.Bits. - - - - - 3570eda5 by Sylvain Henry at 2022-03-04T12:45:42-05:00 Fix comments about Int64/Word64 primops - - - - - 6f84ee33 by Artem Pelenitsyn at 2022-03-05T01:06:47-05:00 remove MonadFail instances of ST CLC proposal: https://github.com/haskell/core-libraries-committee/issues/33 The instances had `fail` implemented in terms of `error`, whereas the idea of the `MonadFail` class is that the `fail` method should be implemented in terms of the monad itself. - - - - - 584cd5ae by sheaf at 2022-03-05T01:07:25-05:00 Don't allow Float#/Double# literal patterns This patch does the following two things: 1. Fix the check in Core Lint to properly throw an error when it comes across Float#/Double# literal patterns. The check was incorrect before, because it expected the type to be Float/Double instead of Float#/Double#. 2. Add an error in the parser when the user writes a floating-point literal pattern such as `case x of { 2.0## -> ... }`. Fixes #21115 - - - - - 706deee0 by Greg Steuck at 2022-03-05T17:44:10-08:00 Make T20214 terminate promptly be setting input to /dev/null It was hanging and timing out on OpenBSD before. - - - - - 14e90098 by Simon Peyton Jones at 2022-03-07T14:05:41-05:00 Always generalise top-level bindings Fix #21023 by always generalising top-level binding; change the documentation of -XMonoLocalBinds to match. - - - - - c9c31c3c by Matthew Pickering at 2022-03-07T14:06:16-05:00 hadrian: Add little flavour transformer to build stage2 with assertions This can be useful to build a `perf+assertions` build or even better `default+no_profiled_libs+omit_pragmas+assertions`. - - - - - 89c14a6c by Matthew Pickering at 2022-03-07T14:06:16-05:00 ci: Convert all deb10 make jobs into hadrian jobs This is the first step in converting all the CI configs to use hadrian rather than make. (#21129) The metrics increase due to hadrian using --hyperlinked-source for haddock builds. (See #21156) ------------------------- Metric Increase: haddock.Cabal haddock.base haddock.compiler ------------------------- - - - - - 7bfae2ee by Matthew Pickering at 2022-03-07T14:06:16-05:00 Replace use of BIN_DIST_PREP_TAR_COMP with BIN_DIST_NAME And adds a check to make sure we are not accidently settings BIN_DIST_PREP_TAR_COMP when using hadrian. - - - - - 5b35ca58 by Matthew Pickering at 2022-03-07T14:06:16-05:00 Fix gen_contents_index logic for hadrian bindist - - - - - 273bc133 by Krzysztof Gogolewski at 2022-03-07T14:06:52-05:00 Fix reporting constraints in pprTcSolverReportMsg 'no_instance_msg' and 'no_deduce_msg' were omitting the first wanted. - - - - - 5874a30a by Simon Jakobi at 2022-03-07T14:07:28-05:00 Improve setBit for Natural Previously the default definition was used, which involved allocating intermediate Natural values. Fixes #21173. - - - - - 7a02aeb8 by Matthew Pickering at 2022-03-07T14:08:03-05:00 Remove leftover trace in testsuite - - - - - 6ce6c250 by Andreas Klebinger at 2022-03-07T23:48:56-05:00 Expand and improve the Note [Strict Worker Ids]. I've added an explicit mention of the invariants surrounding those. As well as adding more direct cross references to the Strict Field Invariant. - - - - - d0f892fe by Ryan Scott at 2022-03-07T23:49:32-05:00 Delete GenericKind_ in favor of GenericKind_DC When deriving a `Generic1` instance, we need to know what the last type variable of a data type is. Previously, there were two mechanisms to determine this information: * `GenericKind_`, where `Gen1_` stored the last type variable of a data type constructor (i.e., the `tyConTyVars`). * `GenericKind_DC`, where `Gen1_DC` stored the last universally quantified type variable in a data constructor (i.e., the `dataConUnivTyVars`). These had different use cases, as `GenericKind_` was used for generating `Rep(1)` instances, while `GenericKind_DC` was used for generating `from(1)` and `to(1)` implementations. This was already a bit confusing, but things went from confusing to outright wrong after !6976. This is because after !6976, the `deriving` machinery stopped using `tyConTyVars` in favor of `dataConUnivTyVars`. Well, everywhere with the sole exception of `GenericKind_`, which still continued to use `tyConTyVars`. This lead to disaster when deriving a `Generic1` instance for a GADT family instance, as the `tyConTyVars` do not match the `dataConUnivTyVars`. (See #21185.) The fix is to stop using `GenericKind_` and replace it with `GenericKind_DC`. For the most part, this proves relatively straightforward. Some highlights: * The `forgetArgVar` function was deleted entirely, as it no longer proved necessary after `GenericKind_`'s demise. * The substitution that maps from the last type variable to `Any` (see `Note [Generating a correctly typed Rep instance]`) had to be moved from `tc_mkRepTy` to `tc_mkRepFamInsts`, as `tc_mkRepTy` no longer has access to the last type variable. Fixes #21185. - - - - - a60ddffd by Matthew Pickering at 2022-03-08T22:51:37+00:00 Move bootstrap and cabal-reinstall test jobs to nightly CI is creaking under the pressure of too many jobs so attempt to reduce the strain by removing a couple of jobs. - - - - - 7abe3288 by Matthew Pickering at 2022-03-09T10:24:15+00:00 Add 10 minute timeout to linters job - - - - - 3cf75ede by Matthew Pickering at 2022-03-09T10:24:16+00:00 Revert "hadrian: Correctly set whether we have a debug compiler when running tests" Needing the arguments for "GHC/Utils/Constant.hs" implies a dependency on the previous stage compiler. Whilst we work out how to get around this I will just revert this commit (as it only affects running the testsuite in debug way). This reverts commit ce65d0cceda4a028f30deafa3c39d40a250acc6a. - - - - - 18b9ba56 by Matthew Pickering at 2022-03-09T11:07:23+00:00 ci: Fix save_cache function Each interation of saving the cache would copy the whole `cabal` store into a subfolder in the CACHE_DIR rather than copying the contents of the cabal store into the cache dir. This resulted in a cache which looked like: ``` /builds/ghc/ghc/cabal-cache/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/ ``` So it would get one layer deeper every CI run and take longer and longer to compress. - - - - - bc684dfb by Ben Gamari at 2022-03-10T03:20:07-05:00 mr-template: Mention timeframe for review - - - - - 7f5f4ede by Vladislav Zavialov at 2022-03-10T03:20:43-05:00 Bump submodules: containers, exceptions GHC Proposal #371 requires TypeOperators to use type equality a~b. This submodule update pulls in the appropriate forward-compatibility changes in 'libraries/containers' and 'libraries/exceptions' - - - - - 8532b8a9 by Matthew Pickering at 2022-03-10T03:20:43-05:00 Add an inline pragma to lookupVarEnv The containers bump reduced the size of the Data.IntMap.Internal.lookup function so that it no longer experienced W/W. This means that the size of lookupVarEnv increased over the inlining threshold and it wasn't inlined into the hot code path in substTyVar. See containers#821, #21159 and !7638 for some more explanation. ------------------------- Metric Decrease: LargeRecord T12227 T13386 T15703 T18223 T5030 T8095 T9872a T9872b T9872c TcPlugin_RewritePerf ------------------------- - - - - - 844cf1e1 by Matthew Pickering at 2022-03-10T03:20:43-05:00 Normalise output of T10970 test The output of this test changes each time the containers submodule version updates. It's easier to apply the version normaliser so that the test checks that there is a version number, but not which one it is. - - - - - 24b6af26 by Ryan Scott at 2022-03-11T19:56:28-05:00 Refactor tcDeriving to generate tyfam insts before any bindings Previously, there was an awful hack in `genInst` (now called `genInstBinds` after this patch) where we had to return a continutation rather than directly returning the bindings for a derived instance. This was done for staging purposes, as we had to first infer the instance contexts for derived instances and then feed these contexts into the continuations to ensure the generated instance bindings had accurate instance contexts. `Note [Staging of tcDeriving]` in `GHC.Tc.Deriving` described this confusing state of affairs. The root cause of this confusing design was the fact that `genInst` was trying to generate instance bindings and associated type family instances for derived instances simultaneously. This really isn't possible, however: as `Note [Staging of tcDeriving]` explains, one needs to have access to the associated type family instances before one can properly infer the instance contexts for derived instances. The use of continuation-returning style was an attempt to circumvent this dependency, but it did so in an awkward way. This patch detangles this awkwardness by splitting up `genInst` into two functions: `genFamInsts` (for associated type family instances) and `genInstBinds` (for instance bindings). Now, the `tcDeriving` function calls `genFamInsts` and brings all the family instances into scope before calling `genInstBinds`. This removes the need for the awkward continuation-returning style seen in the previous version of `genInst`, making the code easier to understand. There are some knock-on changes as well: 1. `hasStockDeriving` now needs to return two separate functions: one that describes how to generate family instances for a stock-derived instance, and another that describes how to generate the instance bindings. I factored out this pattern into a new `StockGenFns` data type. 2. While documenting `StockGenFns`, I realized that there was some inconsistency regarding which `StockGenFns` functions needed which arguments. In particular, the function in `GHC.Tc.Deriv.Generics` which generates `Rep(1)` instances did not take a `SrcSpan` like other `gen_*` functions did, and it included an extra `[Type]` argument that was entirely redundant. As a consequence, I refactored the code in `GHC.Tc.Deriv.Generics` to more closely resemble other `gen_*` functions. A happy result of all this is that all `StockGenFns` functions now take exactly the same arguments, which makes everything more uniform. This is purely a refactoring that should not have any effect on user-observable behavior. The new design paves the way for an eventual fix for #20719. - - - - - 62caaa9b by Ben Gamari at 2022-03-11T19:57:03-05:00 gitlab-ci: Use the linters image in hlint job As the `hlint` executable is only available in the linters image. Fixes #21146. - - - - - 4abd7eb0 by Matthew Pickering at 2022-03-11T19:57:38-05:00 Remove partOfGhci check in the loader This special logic has been part of GHC ever since template haskell was introduced in 9af77fa423926fbda946b31e174173d0ec5ebac8. It's hard to believe in any case that this special logic pays its way at all. Given * The list is out-of-date, which has potential to lead to miscompilation when using "editline", which was removed in 2010 (46aed8a4). * The performance benefit seems negligable as each load only happens once anyway and packages specified by package flags are preloaded into the linker state at the start of compilation. Therefore we just remove this logic. Fixes #19791 - - - - - c40cbaa2 by Andreas Klebinger at 2022-03-11T19:58:14-05:00 Improve -dtag-inference-checks checks. FUN closures don't get tagged when evaluated. So no point in checking their tags. - - - - - ab00d23b by Simon Jakobi at 2022-03-11T19:58:49-05:00 Improve clearBit and complementBit for Natural Also optimize bigNatComplementBit#. Fixes #21175, #21181, #21194. - - - - - a6d8facb by Sebastian Graf at 2022-03-11T19:59:24-05:00 gitignore all (build) directories headed by _ - - - - - 524795fe by Sebastian Graf at 2022-03-11T19:59:24-05:00 Demand: Document why we need three additional equations of multSubDmd - - - - - 6bdcd557 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: make 64-bit word splitting for 32-bit targets respect target endianness This used to been broken for little-endian targets. - - - - - 9e67c69e by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: fix Double# literal payload for 32-bit targets Contrary to the legacy comment, the splitting didn't happen and we ended up with a single StgWord64 literal in the output code! Let's just do the splitting here. - - - - - 1eee2e28 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: use __builtin versions of memcpyish functions to fix type mismatch Our memcpyish primop's type signatures doesn't match the C type signatures. It's not a problem for typical archs, since their C ABI permits dropping the result, but it doesn't work for wasm. The previous logic would cast the memcpyish function pointer to an incorrect type and perform an indirect call, which results in a runtime trap on wasm. The most straightforward fix is: don't emit EFF_ for memcpyish functions. Since we don't want to include extra headers in .hc to bring in their prototypes, we can just use the __builtin versions. - - - - - 9d8d4837 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: emit __builtin_unreachable() when CmmSwitch doesn't contain fallback case Otherwise the C compiler may complain "warning: non-void function does not return a value in all control paths [-Wreturn-type]". - - - - - 27da5540 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: make floatToWord32/doubleToWord64 faster Use castFloatToWord32/castDoubleToWord64 in base to perform the reinterpret cast. - - - - - c98e8332 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: fix -Wunused-value warning in ASSIGN_BaseReg When ASSIGN_BaseReg is a no-op, we shouldn't generate any C code, otherwise C compiler complains a bunch of -Wunused-value warnings when doing unregisterised codegen. - - - - - 5932247c by Ben Gamari at 2022-03-11T20:00:36-05:00 users guide: Eliminate spurious \spxentry mentions We were failing to pass the style file to `makeindex`, as is done by the mklatex configuration generated by Sphinx. Fixes #20913. - - - - - e40cf4ef by Simon Jakobi at 2022-03-11T20:01:11-05:00 ghc-bignum: Tweak integerOr The result of ORing two BigNats is always greater or equal to the larger of the two. Therefore it is safe to skip the magnitude checks of integerFromBigNat#. - - - - - cf081476 by Vladislav Zavialov at 2022-03-12T07:02:40-05:00 checkUnboxedLitPat: use non-fatal addError This enables GHC to report more parse errors in a single pass. - - - - - 7fe07143 by Andreas Klebinger at 2022-03-12T07:03:16-05:00 Rename -fprof-late-ccs to -fprof-late - - - - - 88a94541 by Sylvain Henry at 2022-03-12T07:03:56-05:00 Hadrian: avoid useless allocations in trackArgument Cf ticky report before the change: Entries Alloc Alloc'd Non-void Arguments STG Name -------------------------------------------------------------------------------- 696987 29044128 0 1 L main:Target.trackArgument_go5{v r24kY} (fun) - - - - - 2509d676 by Sylvain Henry at 2022-03-12T07:04:36-05:00 Hadrian: avoid allocating in stageString (#19209) - - - - - c062fac0 by Sylvain Henry at 2022-03-12T07:04:36-05:00 Hadrian: remove useless imports Added for no reason in 7ce1b694f7be7fbf6e2d7b7eb0639e61fbe358c6 - - - - - c82fb934 by Sylvain Henry at 2022-03-12T07:05:16-05:00 Hadrian: avoid allocations in WayUnit's Read instance (#19209) - - - - - ed04aed2 by Sylvain Henry at 2022-03-12T07:05:16-05:00 Hadrian: use IntSet Binary instance for Way (#19209) - - - - - ad835531 by Simon Peyton Jones at 2022-03-13T18:12:12-04:00 Fix bug in weak loop-breakers in OccurAnal Note [Weak loop breakers] explains why we need to track variables free in RHS of rules. But we need to do this for /inactive/ rules as well as active ones, unlike the rhs_fv_env stuff. So we now have two fields in node Details, one for free vars of active rules, and one for free vars of all rules. This was shown up by #20820, which is now fixed. - - - - - 76b94b72 by Sebastian Graf at 2022-03-13T18:12:48-04:00 Worker/wrapper: Preserve float barriers (#21150) Issue #21150 shows that worker/wrapper allocated a worker function for a function with multiple calls that said "called at most once" when the first argument was absent. That's bad! This patch makes it so that WW preserves at least one non-one-shot value lambda (see `Note [Preserving float barriers]`) by passing around `void#` in place of absent arguments. Fixes #21150. Since the fix is pretty similar to `Note [Protecting the last value argument]`, I put the logic in `mkWorkerArgs`. There I realised (#21204) that `-ffun-to-thunk` is basically useless with `-ffull-laziness`, so I deprecated the flag, simplified and split into `needsVoidWorkerArg`/`addVoidWorkerArg`. SpecConstr is another client of that API. Fixes #21204. Metric Decrease: T14683 - - - - - 97db789e by romes at 2022-03-14T11:36:39-04:00 Fix up Note [Bind free vars] Move GHC-specific comments from Language.Haskell.Syntax.Binds to GHC.Hs.Binds It looks like the Note was deleted but there were actually two copies of it. L.H.S.B no longer references it, and GHC.Hs.Binds keeps an updated copy. (See #19252) There are other duplicated notes -- they will be fixed in the next commit - - - - - 135888dd by romes at 2022-03-14T11:36:39-04:00 TTG Pull AbsBinds and ABExport out of the main AST AbsBinds and ABExport both depended on the typechecker, and were thus removed from the main AST Expr. CollectPass now has a new function `collectXXHsBindsLR` used for the new HsBinds extension point Bumped haddock submodule to work with AST changes. The removed Notes from Language.Haskell.Syntax.Binds were duplicated (and not referenced) and the copies in GHC.Hs.Binds are kept (and referenced there). (See #19252) - - - - - 106413f0 by sheaf at 2022-03-14T11:37:21-04:00 Add two coercion optimisation perf tests - - - - - 8eadea67 by sheaf at 2022-03-14T15:08:24-04:00 Fix isLiftedType_maybe and handle fallout As #20837 pointed out, `isLiftedType_maybe` returned `Just False` in many situations where it should return `Nothing`, because it didn't take into account type families or type variables. In this patch, we fix this issue. We rename `isLiftedType_maybe` to `typeLevity_maybe`, which now returns a `Levity` instead of a boolean. We now return `Nothing` for types with kinds of the form `TYPE (F a1 ... an)` for a type family `F`, as well as `TYPE (BoxedRep l)` where `l` is a type variable. This fix caused several other problems, as other parts of the compiler were relying on `isLiftedType_maybe` returning a `Just` value, and were now panicking after the above fix. There were two main situations in which panics occurred: 1. Issues involving the let/app invariant. To uphold that invariant, we need to know whether something is lifted or not. If we get an answer of `Nothing` from `isLiftedType_maybe`, then we don't know what to do. As this invariant isn't particularly invariant, we can change the affected functions to not panic, e.g. by behaving the same in the `Just False` case and in the `Nothing` case (meaning: no observable change in behaviour compared to before). 2. Typechecking of data (/newtype) constructor patterns. Some programs involving patterns with unknown representations were accepted, such as T20363. Now that we are stricter, this caused further issues, culminating in Core Lint errors. However, the behaviour was incorrect the whole time; the incorrectness only being revealed by this change, not triggered by it. This patch fixes this by overhauling where the representation polymorphism involving pattern matching are done. Instead of doing it in `tcMatches`, we instead ensure that the `matchExpected` functions such as `matchExpectedFunTys`, `matchActualFunTySigma`, `matchActualFunTysRho` allow return argument pattern types which have a fixed RuntimeRep (as defined in Note [Fixed RuntimeRep]). This ensures that the pattern matching code only ever handles types with a known runtime representation. One exception was that patterns with an unknown representation type could sneak in via `tcConPat`, which points to a missing representation-polymorphism check, which this patch now adds. This means that we now reject the program in #20363, at least until we implement PHASE 2 of FixedRuntimeRep (allowing type families in RuntimeRep positions). The aforementioned refactoring, in which checks have been moved to `matchExpected` functions, is a first step in implementing PHASE 2 for patterns. Fixes #20837 - - - - - 8ff32124 by Sebastian Graf at 2022-03-14T15:09:01-04:00 DmdAnal: Don't unbox recursive data types (#11545) As `Note [Demand analysis for recursive data constructors]` describes, we now refrain from unboxing recursive data type arguments, for two reasons: 1. Relating to run/alloc perf: Similar to `Note [CPR for recursive data constructors]`, it seldomly improves run/alloc performance if we just unbox a finite number of layers of a potentially huge data structure. 2. Relating to ghc/alloc perf: Inductive definitions on single-product recursive data types like the one in T11545 will (diverge, and) have very deep demand signatures before any other abortion mechanism in Demand analysis is triggered. That leads to great and unnecessary churn on Demand analysis when ultimately we will never make use of any nested strictness information anyway. Conclusion: Discard nested demand and boxity information on such recursive types with the help of `Note [Detecting recursive data constructors]`. I also implemented `GHC.Types.Unique.MemoFun.memoiseUniqueFun` in order to avoid the overhead of repeated calls to `GHC.Core.Opt.WorkWrap.Utils.isRecDataCon`. It's nice and simple and guards against some smaller regressions in T9233 and T16577. ghc/alloc performance-wise, this patch is a very clear win: Test Metric value New value Change --------------------------------------------------------------------------------------- LargeRecord(normal) ghc/alloc 6,141,071,720 6,099,871,216 -0.7% MultiLayerModulesTH_OneShot(normal) ghc/alloc 2,740,973,040 2,705,146,640 -1.3% T11545(normal) ghc/alloc 945,475,492 85,768,928 -90.9% GOOD T13056(optasm) ghc/alloc 370,245,880 326,980,632 -11.7% GOOD T18304(normal) ghc/alloc 90,933,944 76,998,064 -15.3% GOOD T9872a(normal) ghc/alloc 1,800,576,840 1,792,348,760 -0.5% T9872b(normal) ghc/alloc 2,086,492,432 2,073,991,848 -0.6% T9872c(normal) ghc/alloc 1,750,491,240 1,737,797,832 -0.7% TcPlugin_RewritePerf(normal) ghc/alloc 2,286,813,400 2,270,957,896 -0.7% geo. mean -2.9% No noteworthy change in run/alloc either. NoFib results show slight wins, too: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- constraints -1.9% -1.4% fasta -3.6% -2.7% reverse-complem -0.3% -0.9% treejoin -0.0% -0.3% -------------------------------------------------------------------------------- Min -3.6% -2.7% Max +0.1% +0.1% Geometric Mean -0.1% -0.1% Metric Decrease: T11545 T13056 T18304 - - - - - ab618309 by Vladislav Zavialov at 2022-03-15T18:34:38+03:00 Export (~) from Data.Type.Equality (#18862) * Users can define their own (~) type operator * Haddock can display documentation for the built-in (~) * New transitional warnings implemented: -Wtype-equality-out-of-scope -Wtype-equality-requires-operators Updates the haddock submodule. - - - - - 577135bf by Aaron Allen at 2022-03-16T02:27:48-04:00 Convert Diagnostics in GHC.Tc.Gen.Foreign Converts all uses of 'TcRnUnknownMessage' to proper diagnostics. - - - - - c1fed9da by Aaron Allen at 2022-03-16T02:27:48-04:00 Suggest FFI extensions as hints (#20116) - Use extension suggestion hints instead of suggesting extensions in the error message body for several FFI errors. - Adds a test case for `TcRnForeignImportPrimExtNotSet` - - - - - a33d1045 by Zubin Duggal at 2022-03-16T02:28:24-04:00 TH: allow negative patterns in quotes (#20711) We still don't allow negative overloaded patterns. Earler all negative patterns were treated as negative overloaded patterns. Now, we expliclty check the extension field to see if the pattern is actually a negative overloaded pattern - - - - - 1575c4a5 by Sebastian Graf at 2022-03-16T02:29:03-04:00 Demand: Let `Boxed` win in `lubBoxity` (#21119) Previously, we let `Unboxed` win in `lubBoxity`, which is unsoundly optimistic in terms ob Boxity analysis. "Unsoundly" in the sense that we sometimes unbox parameters that we better shouldn't unbox. Examples are #18907 and T19871.absent. Until now, we thought that this hack pulled its weight becuase it worked around some shortcomings of the phase separation between Boxity analysis and CPR analysis. But it is a gross hack which caused regressions itself that needed all kinds of fixes and workarounds. See for example #20767. It became impossible to work with in !7599, so I want to remove it. For example, at the moment, `lubDmd B dmd` will not unbox `dmd`, but `lubDmd A dmd` will. Given that `B` is supposed to be the bottom element of the lattice, it's hardly justifiable to get a better demand when `lub`bing with `A`. The consequence of letting `Boxed` win in `lubBoxity` is that we *would* regress #2387, #16040 and parts of #5075 and T19871.sumIO, until Boxity and CPR are able to communicate better. Fortunately, that is not the case since I could tweak the other source of optimism in Boxity analysis that is described in `Note [Unboxed demand on function bodies returning small products]` so that we *recursively* assume unboxed demands on function bodies returning small products. See the updated Note. `Note [Boxity for bottoming functions]` describes why we need bottoming functions to have signatures that say that they deeply unbox their arguments. In so doing, I had to tweak `finaliseArgBoxities` so that it will never unbox recursive data constructors. This is in line with our handling of them in CPR. I updated `Note [Which types are unboxed?]` to reflect that. In turn we fix #21119, #20767, #18907, T19871.absent and get a much simpler implementation (at least to think about). We can also drop the very ad-hoc definition of `deferAfterPreciseException` and its Note in favor of the simple, intuitive definition we used to have. Metric Decrease: T16875 T18223 T18698a T18698b hard_hole_fits Metric Increase: LargeRecord MultiComponentModulesRecomp T15703 T8095 T9872d Out of all the regresions, only the one in T9872d doesn't vanish in a perf build, where the compiler is bootstrapped with -O2 and thus SpecConstr. Reason for regressions: * T9872d is due to `ty_co_subst` taking its `LiftingContext` boxed. That is because the context is passed to a function argument, for example in `liftCoSubstTyVarBndrUsing`. * In T15703, LargeRecord and T8095, we get a bit more allocations in `expand_syn` and `piResultTys`, because a `TCvSubst` isn't unboxed. In both cases that guards against reboxing in some code paths. * The same is true for MultiComponentModulesRecomp, where we get less unboxing in `GHC.Unit.Finder.$wfindInstalledHomeModule`. In a perf build, allocations actually *improve* by over 4%! Results on NoFib: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- awards -0.4% +0.3% cacheprof -0.3% +2.4% fft -1.5% -5.1% fibheaps +1.2% +0.8% fluid -0.3% -0.1% ida +0.4% +0.9% k-nucleotide +0.4% -0.1% last-piece +10.5% +13.9% lift -4.4% +3.5% mandel2 -99.7% -99.8% mate -0.4% +3.6% parser -1.0% +0.1% puzzle -11.6% +6.5% reverse-complem -3.0% +2.0% scs -0.5% +0.1% sphere -0.4% -0.2% wave4main -8.2% -0.3% -------------------------------------------------------------------------------- Summary excludes mandel2 because of excessive bias Min -11.6% -5.1% Max +10.5% +13.9% Geometric Mean -0.2% +0.3% -------------------------------------------------------------------------------- Not bad for a bug fix. The regression in `last-piece` could become a win if SpecConstr would work on non-recursive functions. The regression in `fibheaps` is due to `Note [Reboxed crud for bottoming calls]`, e.g., #21128. - - - - - bb779b90 by sheaf at 2022-03-16T02:29:42-04:00 Add a regression test for #21130 This problem was due to a bug in cloneWanted, which was incorrectly creating a coercion hole to hold an evidence variable. This bug was introduced by 8bb52d91 and fixed in 81740ce8. Fixes #21130 - - - - - 0f0e2394 by Tamar Christina at 2022-03-17T10:16:37-04:00 linker: Initial Windows C++ exception unwinding support - - - - - 36d20d4d by Tamar Christina at 2022-03-17T10:16:37-04:00 linker: Fix ADDR32NB relocations on Windows - - - - - 8a516527 by Tamar Christina at 2022-03-17T10:16:37-04:00 testsuite: properly escape string paths - - - - - 1a0dd008 by sheaf at 2022-03-17T10:17:13-04:00 Hadrian: account for change in late-ccs flag The late cost centre flag was renamed from -fprof-late-ccs to -fprof-late in 7fe07143, but this change hadn't been propagated to Hadrian. - - - - - 8561c1af by romes at 2022-03-18T05:10:58-04:00 TTG: Refactor HsBracket - - - - - 19163397 by romes at 2022-03-18T05:10:58-04:00 Type-checking untyped brackets When HsExpr GhcTc, the HsBracket constructor should hold a HsBracket GhcRn, rather than an HsBracket GhcTc. We make use of the HsBracket p extension constructor (XBracket (XXBracket p)) to hold an HsBracket GhcRn when the pass is GhcTc See !4782 https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - 310890a5 by romes at 2022-03-18T05:10:58-04:00 Separate constructors for typed and untyped brackets Split HsBracket into HsTypedBracket and HsUntypedBracket. Unfortunately, we still cannot get rid of instance XXTypedBracket GhcTc = HsTypedBracket GhcRn despite no longer requiring it for typechecking, but rather because the TH desugarer works on GhcRn rather than GhcTc (See GHC.HsToCore.Quote) - - - - - 4a2567f5 by romes at 2022-03-18T05:10:58-04:00 TTG: Refactor bracket for desugaring during tc When desugaring a bracket we want to desugar /renamed/ rather than /typechecked/ code; So in (HsExpr GhcTc) tree, we must have a (HsExpr GhcRn) for the quotation itself. This commit reworks the TTG refactor on typed and untyped brackets by storing the /renamed/ code in the bracket field extension rather than in the constructor extension in `HsQuote` (previously called `HsUntypedBracket`) See Note [The life cycle of a TH quotation] and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - b056adc8 by romes at 2022-03-18T05:10:58-04:00 TTG: Make HsQuote GhcTc isomorphic to NoExtField An untyped bracket `HsQuote p` can never be constructed with `p ~ GhcTc`. This is because we don't typecheck `HsQuote` at all. That's OK, because we also never use `HsQuote GhcTc`. To enforce this at the type level we make `HsQuote GhcTc` isomorphic to `NoExtField` and impossible to construct otherwise, by using TTG field extensions to make all constructors, except for `XQuote` (which takes `NoExtField`), unconstructable, with `DataConCantHappen` This is explained more in detail in Note [The life cycle of a TH quotation] Related discussion: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - ac3b2e7d by romes at 2022-03-18T05:10:58-04:00 TTG: TH brackets finishing touches Rewrite the critical notes and fix outdated ones, use `HsQuote GhcRn` (in `HsBracketTc`) for desugaring regardless of the bracket being typed or untyped, remove unused `EpAnn` from `Hs*Bracket GhcRn`, zonkExpr factor out common brackets code, ppr_expr factor out common brackets code, and fix tests, to finish MR https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782. ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - d147428a by Ben Gamari at 2022-03-18T05:11:35-04:00 codeGen: Fix signedness of jump table indexing Previously while constructing the jump table index we would zero-extend the discriminant before subtracting the start of the jump-table. This goes subtly wrong in the case of a sub-word, signed discriminant, as described in the included Note. Fix this in both the PPC and X86 NCGs. Fixes #21186. - - - - - 435a3d5d by Ben Gamari at 2022-03-18T05:11:35-04:00 testsuite: Add test for #21186 - - - - - e9d8de93 by Zubin Duggal at 2022-03-19T07:35:49-04:00 TH: Fix pretty printing of newtypes with operators and GADT syntax (#20868) The pretty printer for regular data types already accounted for these, and had some duplication with the newtype pretty printer. Factoring the logic out into a common function and using it for both newtypes and data declarations is enough to fix the bug. - - - - - 244da9eb by sheaf at 2022-03-19T07:36:24-04:00 List GHC.Event.Internal in base.cabal on Windows GHC.Event.Internal was not listed in base.cabal on Windows. This caused undefined reference errors. This patch adds it back, by moving it out of the OS-specific logic in base.cabal. Fixes #21245. - - - - - d1c03719 by Andreas Klebinger at 2022-03-19T07:37:00-04:00 Compact regions: Maintain tags properly Fixes #21251 - - - - - d45bb701 by romes at 2022-03-19T07:37:36-04:00 Remove dead code HsDoRn - - - - - c842611f by nineonine at 2022-03-20T21:16:06-04:00 Revamp derived Eq instance code generation (#17240) This patch improves code generation for derived Eq instances. The idea is to use 'dataToTag' to evaluate both arguments. This allows to 'short-circuit' when tags do not match. Unfortunately, inner evals are still present when we branch on tags. This is due to the way 'dataToTag#' primop evaluates its argument in the code generator. #21207 was created to explore further optimizations. Metric Decrease: LargeRecord - - - - - 52ffd38c by Sylvain Henry at 2022-03-20T21:16:46-04:00 Avoid some SOURCE imports - - - - - b91798be by Zubin Duggal at 2022-03-23T13:39:39-04:00 hi haddock: Lex and store haddock docs in interface files Names appearing in Haddock docstrings are lexed and renamed like any other names appearing in the AST. We currently rename names irrespective of the namespace, so both type and constructor names corresponding to an identifier will appear in the docstring. Haddock will select a given name as the link destination based on its own heuristics. This patch also restricts the limitation of `-haddock` being incompatible with `Opt_KeepRawTokenStream`. The export and documenation structure is now computed in GHC and serialised in .hi files. This can be used by haddock to directly generate doc pages without reparsing or renaming the source. At the moment the operation of haddock is not modified, that's left to a future patch. Updates the haddock submodule with the minimum changes needed. - - - - - 78db231f by Cheng Shao at 2022-03-23T13:40:17-04:00 configure: bump LlvmMaxVersion to 14 LLVM 13.0.0 is released in Oct 2021, and latest head validates against LLVM 13 just fine if LlvmMaxVersion is bumped. - - - - - b06e5dd8 by Adam Sandberg Ericsson at 2022-03-23T13:40:54-04:00 docs: clarify the eventlog format documentation a little bit - - - - - 4dc62498 by Matthew Pickering at 2022-03-23T13:41:31-04:00 Fix behaviour of -Wunused-packages in ghci Ticket #21110 points out that -Wunused-packages behaves a bit unusually in GHCi. Now we define the semantics for -Wunused-packages in interactive mode as follows: * If you use -Wunused-packages on an initial load then the warning is reported. * If you explicitly set -Wunused-packages on the command line then the warning is displayed (until it is disabled) * If you then subsequently modify the set of available targets by using :load or :cd (:cd unloads everything) then the warning is (silently) turned off. This means that every :r the warning is printed if it's turned on (but you did ask for it). Fixes #21110 - - - - - fed05347 by Ben Gamari at 2022-03-23T13:42:07-04:00 rts/adjustor: Place adjustor templates in data section on all OSs In !7604 we started placing adjustor templates in the data section on Linux as some toolchains there reject relocations in the text section. However, it turns out that OpenBSD also exhibits this restriction. Fix this by *always* placing adjustor templates in the data section. Fixes #21155. - - - - - db32bb8c by Zubin Duggal at 2022-03-23T13:42:44-04:00 Improve error message when warning about unsupported LLVM version (#20958) Change the wording to make it clear that the upper bound is non-inclusive. - - - - - f214349a by Ben Gamari at 2022-03-23T13:43:20-04:00 rts: Untag function field in scavenge_PAP_payload Previously we failed to untag the function closure when scavenging the payload of a PAP, resulting in an invalid closure pointer being passed to scavenge_large_bitmap and consequently #21254. Fix this. Fixes #21254 - - - - - e6d0e287 by Ben Gamari at 2022-03-23T13:43:20-04:00 rts: Don't mark object code in markCAFs unless necessary Previously `markCAFs` would call `markObjectCode` even in non-major GCs. This is problematic since `prepareUnloadCheck` is not called in such GCs, meaning that the section index has not been updated. Fixes #21254 - - - - - 1a7cf096 by Sylvain Henry at 2022-03-23T13:44:05-04:00 Avoid redundant imports of GHC.Driver.Session Remove GHC.Driver.Session imports that weren't considered as redundant because of the reexport of PlatformConstants. Also remove this reexport as modules using this datatype should import GHC.Platform instead. - - - - - e3f60577 by Sylvain Henry at 2022-03-23T13:44:05-04:00 Reverse dependency between StgToCmm and Runtime.Heap.Layout - - - - - e6585ca1 by Sylvain Henry at 2022-03-23T13:44:46-04:00 Define filterOut with filter filter has fusion rules that filterOut lacks - - - - - c58d008c by Ryan Scott at 2022-03-24T06:10:43-04:00 Fix and simplify DeriveAnyClass's context inference using SubTypePredSpec As explained in `Note [Gathering and simplifying constraints for DeriveAnyClass]` in `GHC.Tc.Deriv.Infer`, `DeriveAnyClass` infers instance contexts by emitting implication constraints. Previously, these implication constraints were constructed by hand. This is a terribly trick thing to get right, as it involves a delicate interplay of skolemisation, metavariable instantiation, and `TcLevel` bumping. Despite much effort, we discovered in #20719 that the implementation was subtly incorrect, leading to valid programs being rejected. While we could scrutinize the code that manually constructs implication constraints and repair it, there is a better, less error-prone way to do things. After all, the heart of `DeriveAnyClass` is generating code which fills in each class method with defaults, e.g., `foo = $gdm_foo`. Typechecking this sort of code is tantamount to calling `tcSubTypeSigma`, as we much ensure that the type of `$gdm_foo` is a subtype of (i.e., more polymorphic than) the type of `foo`. As an added bonus, `tcSubTypeSigma` is a battle-tested function that handles skolemisation, metvariable instantiation, `TcLevel` bumping, and all other means of tricky bookkeeping correctly. With this insight, the solution to the problems uncovered in #20719 is simple: use `tcSubTypeSigma` to check if `$gdm_foo`'s type is a subtype of `foo`'s type. As a side effect, `tcSubTypeSigma` will emit exactly the implication constraint that we were attempting to construct by hand previously. Moreover, it does so correctly, fixing #20719 as a consequence. This patch implements the solution thusly: * The `PredSpec` data type (previously named `PredOrigin`) is now split into `SimplePredSpec`, which directly stores a `PredType`, and `SubTypePredSpec`, which stores the actual and expected types in a subtype check. `SubTypePredSpec` is only used for `DeriveAnyClass`; all other deriving strategies use `SimplePredSpec`. * Because `tcSubTypeSigma` manages the finer details of type variable instantiation and constraint solving under the hood, there is no longer any need to delicately split apart the method type signatures in `inferConstraintsAnyclass`. This greatly simplifies the implementation of `inferConstraintsAnyclass` and obviates the need to store skolems, metavariables, or given constraints in a `ThetaSpec` (previously named `ThetaOrigin`). As a bonus, this means that `ThetaSpec` now simply becomes a synonym for a list of `PredSpec`s, which is conceptually much simpler than it was before. * In `simplifyDeriv`, each `SubTypePredSpec` results in a call to `tcSubTypeSigma`. This is only performed for its side effect of emitting an implication constraint, which is fed to the rest of the constraint solving machinery in `simplifyDeriv`. I have updated `Note [Gathering and simplifying constraints for DeriveAnyClass]` to explain this in more detail. To make the changes in `simplifyDeriv` more manageable, I also performed some auxiliary refactoring: * Previously, every iteration of `simplifyDeriv` was skolemising the type variables at the start, simplifying, and then performing a reverse substitution at the end to un-skolemise the type variables. This is not necessary, however, since we can just as well skolemise once at the beginning of the `deriving` pipeline and zonk the `TcTyVar`s after `simplifyDeriv` is finished. This patch does just that, having been made possible by prior work in !7613. I have updated `Note [Overlap and deriving]` in `GHC.Tc.Deriv.Infer` to explain this, and I have also left comments on the relevant data structures (e.g., `DerivEnv` and `DerivSpec`) to explain when things might be `TcTyVar`s or `TyVar`s. * All of the aforementioned cleanup allowed me to remove an ad hoc deriving-related in `checkImplicationInvariants`, as all of the skolems in a `tcSubTypeSigma`–produced implication constraint should now be `TcTyVar` at the time the implication is created. * Since `simplifyDeriv` now needs a `SkolemInfo` and `UserTypeCtxt`, I have added `ds_skol_info` and `ds_user_ctxt` fields to `DerivSpec` to store these. Similarly, I have also added a `denv_skol_info` field to `DerivEnv`, which ultimately gets used to initialize the `ds_skol_info` in a `DerivSpec`. Fixes #20719. - - - - - 21680fb0 by Sebastian Graf at 2022-03-24T06:11:19-04:00 WorkWrap: Handle partial FUN apps in `isRecDataCon` (#21265) Partial FUN apps like `(->) Bool` aren't detected by `splitFunTy_maybe`. A silly oversight that is easily fixed by replacing `splitFunTy_maybe` with a guard in the `splitTyConApp_maybe` case. But fortunately, Simon nudged me into rewriting the whole `isRecDataCon` function in a way that makes it much shorter and hence clearer which DataCons are actually considered as recursive. Fixes #21265. - - - - - a2937e2b by Matthew Pickering at 2022-03-24T17:13:22-04:00 Add test for T21035 This test checks that you are allowed to explicitly supply object files for dependencies even if you haven't got the shared object for that library yet. Fixes #21035 - - - - - 1756d547 by Matthew Pickering at 2022-03-24T17:13:58-04:00 Add check to ensure we are not building validate jobs for releases - - - - - 99623358 by Matthew Pickering at 2022-03-24T17:13:58-04:00 hadrian: Correct generation of hsc2hs wrapper If you inspect the inside of a wrapper script for hsc2hs you will see that the cflag and lflag values are concatenated incorrectly. ``` HSC2HS_EXTRA="--cflag=-U__i686--lflag=-fuse-ld=gold" ``` It should instead be ``` HSC2HS_EXTRA="--cflag=-U__i686 --lflag=-fuse-ld=gold" ``` Fixes #21221 - - - - - fefd4e31 by Matthew Pickering at 2022-03-24T17:13:59-04:00 testsuite: Remove library dependenices from T21119 These dependencies would affect the demand signature depending on various rules and so on. Fixes #21271 - - - - - 5ff690b8 by Matthew Pickering at 2022-03-24T17:13:59-04:00 ci: Generate jobs for all normal builds and use hadrian for all builds This commit introduces a new script (.gitlab/gen_ci.hs) which generates a yaml file (.gitlab/jobs.yaml) which contains explicit descriptions for all the jobs we want to run. The jobs are separated into three categories: * validate - jobs run on every MR * nightly - jobs run once per day on the master branch * release - jobs for producing release artifacts The generation script is a Haskell program which includes a DSL for specifying the different jobs. The hope is that it's easier to reason about the different jobs and how the variables are merged together rather than the unclear and opaque yaml syntax. The goal is to fix issues like #21190 once and for all.. The `.gitlab/jobs.yaml` can be generated by running the `.gitlab/generate_jobs` script. You have to do this manually. Another consequence of this patch is that we use hadrian for all the validate, nightly and release builds on all platforms. - - - - - 1d673aa2 by Christiaan Baaij at 2022-03-25T11:35:49-04:00 Add the OPAQUE pragma A new pragma, `OPAQUE`, that ensures that every call of a named function annotated with an `OPAQUE` pragma remains a call of that named function, not some name-mangled variant. Implements GHC proposal 0415: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0415-opaque-pragma.rst This commit also updates the haddock submodule to handle the newly introduced lexer tokens corresponding to the OPAQUE pragma. - - - - - 83f5841b by Andrew Lelechenko at 2022-03-25T11:36:31-04:00 Add instance Lift ByteArray - - - - - 7cc1184a by Matthew Pickering at 2022-03-25T11:37:07-04:00 Make -ddump-rn-ast and -ddump-tc-ast work in GHCi Fixes #17830 - - - - - 940feaf3 by Sylvain Henry at 2022-03-25T11:37:47-04:00 Modularize Tidy (#17957) - Factorize Tidy options into TidyOpts datatype. Initialize it in GHC.Driver.Config.Tidy - Same thing for StaticPtrOpts - Perform lookups of unpackCString[Utf8]# once in initStaticPtrOpts instead of for every use of mkStringExprWithFS - - - - - 25101813 by Takenobu Tani at 2022-03-28T01:16:02-04:00 users-guide: Correct markdown for profiling This patch corrects some markdown. [skip ci] - - - - - c832ae93 by Matthew Pickering at 2022-03-28T01:16:38-04:00 hadrian: Flag cabal flag handling This patch basically deletes some ad-hoc handling of Cabal Flags and replaces it with a correct query of the LocalBuildInfo. The flags in the local build info can be modified by users by passing hadrian options For example (!4331) ``` *.genapply.cabal.configure.opts += --flags=unregisterised ``` And all the flags specified by the `Cabal Flags` builder were already passed to configure properly using `--flags`. - - - - - a9f3a5c6 by Ben Gamari at 2022-03-28T01:16:38-04:00 Disable text's dependency on simdutf by default Unfortunately we are simply not currently in a good position to robustly ship binary distributions which link against C++ code like simdutf. Fixes #20724. - - - - - eff86e8a by Richard Eisenberg at 2022-03-28T01:17:14-04:00 Add Red Herring to Note [What might equal later?] Close #21208. - - - - - 12653be9 by jberryman at 2022-03-28T01:17:55-04:00 Document typed splices inhibiting unused bind detection (#16524) - - - - - 4aeade15 by Adam Sandberg Ericsson at 2022-03-28T01:18:31-04:00 users-guide: group ticky-ticky profiling under one heading - - - - - cc59648a by Sylvain Henry at 2022-03-28T01:19:12-04:00 Hadrian: allow testsuite to run with cross-compilers (#21292) - - - - - 89cb1315 by Matthew Pickering at 2022-03-28T01:19:48-04:00 hadrian: Add show target to bindist makefile Some build systems use "make show" to query facts about the bindist, for example: ``` make show VALUE=ProjectVersion > version ``` to determine the ProjectVersion - - - - - 8229885c by Alan Zimmerman at 2022-03-28T19:23:28-04:00 EPA: let stmt with semicolon has wrong anchor The code let ;x =1 Captures the semicolon annotation, but did not widen the anchor in the ValBinds. Fix that. Closes #20247 - - - - - 2c12627c by Ryan Scott at 2022-03-28T19:24:04-04:00 Consistently attach SrcSpans to sub-expressions in TH splices Before, `GHC.ThToHs` was very inconsistent about where various sub-expressions would get the same `SrcSpan` from the original TH splice location or just a generic `noLoc` `SrcSpan`. I have ripped out all uses of `noLoc` in favor of the former instead, and I have added a `Note [Source locations within TH splices]` to officially enshrine this design choice. Fixes #21299. - - - - - 789add55 by Zubin Duggal at 2022-03-29T13:07:22-04:00 Fix all invalid haddock comments in the compiler Fixes #20935 and #20924 - - - - - 967dad03 by Zubin Duggal at 2022-03-29T13:07:22-04:00 hadrian: Build lib:GHC with -haddock and -Winvalid-haddock (#21273) - - - - - ad09a5f7 by sheaf at 2022-03-29T13:08:05-04:00 Hadrian: make DDEBUG separate from debugged RTS This patchs separates whether -DDEBUG is enabled (i.e. whether debug assertions are enabled) from whether we are using the debugged RTS (i.e. GhcDebugged = YES). This means that we properly skip tests which have been marked with `when(compiler_debugged(), skip)`. Fixes #21113, #21153 and #21234 - - - - - 840a6811 by Matthew Pickering at 2022-03-29T13:08:42-04:00 RTS: Zero gc_cpu_start and gc_cpu_end after accounting When passed a combination of `-N` and `-qn` options the cpu time for garbage collection was being vastly overcounted because the counters were not being zeroed appropiately. When -qn1 is passed, only 1 of the N avaiable GC threads is chosen to perform work, the rest are idle. At the end of the GC period, stat_endGC traverses all the GC threads and adds up the elapsed time from each of them. For threads which didn't participate in this GC, the value of the cpu time should be zero, but before this patch, the counters were not zeroed and hence we would count the same elapsed time on many subsequent iterations (until the thread participated in a GC again). The most direct way to zero these fields is to do so immediately after the value is added into the global counter, after which point they are never used again. We also tried another approach where we would zero the counter in yieldCapability but there are some (undiagnosed) siations where a capbility would not pass through yieldCapability before the GC ended and the same double counting problem would occur. Fixes #21082 - - - - - dda46e2d by Matthew Pickering at 2022-03-29T13:09:18-04:00 Add test for T21306 Fixes #21306 - - - - - f07c7766 by Jakob Brünker at 2022-03-30T03:10:33-04:00 Give parsing plugins access to errors Previously, when the parser produced non-fatal errors (i.e. it produced errors but the 'PState' is 'POk'), compilation would be aborted before the 'parsedResultAction' of any plugin was invoked. This commit changes that, so that such that 'parsedResultAction' gets collections of warnings and errors as argument, and must return them after potentially modifying them. Closes #20803 - - - - - e5dfde75 by Ben Gamari at 2022-03-30T03:11:10-04:00 Fix reference to Note [FunBind vs PatBind] This Note was renamed in 2535a6716202253df74d8190b028f85cc6d21b72 yet this occurrence was not updated. - - - - - 21894a63 by Krzysztof Gogolewski at 2022-03-30T03:11:45-04:00 Refactor: make primtypes independent of PrimReps Previously, 'pcPrimTyCon', the function used to define a primitive type, was taking a PrimRep, only to convert it to a RuntimeRep. Now it takes a RuntimeRep directly. Moved primRepToRuntimeRep to GHC.Types.RepType. It is now located next to its inverse function runtimeRepPrimRep. Now GHC.Builtin.Types.Prim no longer mentions PrimRep, and GHC.Types.RepType no longer imports GHC.Builtin.Types.Prim. Removed unused functions `primRepsToRuntimeRep` and `mkTupleRep`. Removed Note [PrimRep and kindPrimRep] - it was never referenced, didn't belong to Types.Prim, and Note [Getting from RuntimeRep to PrimRep] is more comprehensive. - - - - - 43da2963 by Matthew Pickering at 2022-03-30T09:55:49+01:00 Fix mention of non-existent "rehydrateIface" function [skip ci] Fixes #21303 - - - - - 6793a20f by gershomb at 2022-04-01T10:33:46+01:00 Remove wrong claim about naturality law. This docs change removes a longstanding confusion in the Traversable docs. The docs say "(The naturality law is implied by parametricity and thus so is the purity law [1, p15].)". However if one reads the reference a different "natural" law is implied by parametricity. The naturality law given as a law here is imposed. Further, the reference gives examples which violate both laws -- so they cannot be implied by parametricity. This PR just removes the wrong claim. - - - - - 5beeff46 by Ben Gamari at 2022-04-01T10:34:39+01:00 Refactor handling of global initializers GHC uses global initializers for a number of things including cost-center registration, info-table provenance registration, and setup of foreign exports. Previously, the global initializer arrays which referenced these initializers would live in the object file of the C stub, which would then be merged into the main object file of the module. Unfortunately, this approach is no longer tenable with the move to Clang/LLVM on Windows (see #21019). Specifically, lld's PE backend does not support object merging (that is, the -r flag). Instead we are now rather packaging a module's object files into a static library. However, this is problematic in the case of initializers as there are no references to the C stub object in the archive, meaning that the linker may drop the object from the final link. This patch refactors our handling of global initializers to instead place initializer arrays within the object file of the module to which they belong. We do this by introducing a Cmm data declaration containing the initializer array in the module's Cmm stream. While the initializer functions themselves remain in separate C stub objects, the reference from the module's object ensures that they are not dropped from the final link. In service of #21068. - - - - - 3e6fe71b by Matthew Pickering at 2022-04-01T10:35:41+01:00 Fix remaining issues in eventlog types (gen_event_types.py) * The size of End concurrent mark phase looks wrong and, it used to be 4 and now it's 0. * The size of Task create is wrong, used to be 18 and now 14. * The event ticky-ticky entry counter begin sample has the wrong name * The event ticky-ticky entry counter being sample has the wrong size, was 0 now 32. Closes #21070 - - - - - 7847f47a by Ben Gamari at 2022-04-01T10:35:41+01:00 users-guide: Fix a few small issues in eventlog format descriptions The CONC_MARK_END event description didn't mention its payload. Clarify the meaning of the CREATE_TASK's payload. - - - - - acfd5a4c by Matthew Pickering at 2022-04-01T10:35:53+01:00 ci: Regenerate jobs.yaml It seems I forgot to update this to reflect the current state of gen_ci.hs - - - - - a952dd80 by Matthew Pickering at 2022-04-01T10:35:59+01:00 ci: Attempt to fix windows cache issues It appears that running the script directly does nothing (no info is printed about saving the cache). - - - - - fb65e6e3 by Adrian Ratiu at 2022-04-01T10:49:52+01:00 fp_prog_ar.m4: take AR var into consideration In ChromeOS and Gentoo we want the ability to use LLVM ar instead of GNU ar even though both are installed, thus we pass (for eg) AR=llvm-ar to configure. Unfortunately GNU ar always gets picked regardless of the AR setting because the check does not consider the AR var when setting fp_prog_ar, hence this fix. - - - - - 1daaefdf by Greg Steuck at 2022-04-01T10:50:16+01:00 T13366 requires c++ & c++abi libraries on OpenBSD Fixes this failure: =====> 1 of 1 [0, 0, 0] T13366(normal) 1 of 1 [0, 0, 0] Compile failed (exit code 1) errors were: <no location info>: error: user specified .o/.so/.DLL could not be loaded (File not found) Whilst trying to load: (dynamic) stdc++ Additional directories searched: (none) *** unexpected failure for T13366(normal) - - - - - 18e6c85b by Jakob Bruenker at 2022-04-01T10:54:28+01:00 new datatypes for parsedResultAction Previously, the warnings and errors were given and returned as a tuple (Messages PsWarnings, Messages PsErrors). Now, it's just PsMessages. This, together with the HsParsedModule the parser plugin gets and returns, has been wrapped up as ParsedResult. - - - - - 9727e592 by Morrow at 2022-04-01T10:55:12+01:00 Clarify that runghc interprets the input program - - - - - f589dea3 by sheaf at 2022-04-01T10:59:58+01:00 Unify RuntimeRep arguments in ty_co_match The `ty_co_match` function ignored the implicit RuntimeRep coercions that occur in a `FunCo`. Even though a comment explained that this should be fine, #21205 showed that it could result in discarding a RuntimeRep coercion, and thus discarding an important cast entirely. With this patch, we first match the kinds in `ty_co_match`. Fixes #21205 ------------------------- Metric Increase: T12227 T18223 ------------------------- - - - - - 6f4dc372 by Andreas Klebinger at 2022-04-01T11:01:35+01:00 Export MutableByteArray from Data.Array.Byte This implements CLC proposal #49 - - - - - 5df9f5e7 by ARATA Mizuki at 2022-04-01T11:02:35+01:00 Add test cases for #20640 Closes #20640 - - - - - 8334ff9e by Krzysztof Gogolewski at 2022-04-01T11:03:16+01:00 Minor cleanup - Remove unused functions exprToCoercion_maybe, applyTypeToArg, typeMonoPrimRep_maybe, runtimeRepMonoPrimRep_maybe. - Replace orValid with a simpler check - Use splitAtList in applyTysX - Remove calls to extra_clean in the testsuite; it does not do anything. Metric Decrease: T18223 - - - - - b2785cfc by Eric Lindblad at 2022-04-01T11:04:07+01:00 hadrian typos - - - - - 418e6fab by Eric Lindblad at 2022-04-01T11:04:12+01:00 two typos - - - - - dd7c7c99 by Phil de Joux at 2022-04-01T11:04:56+01:00 Add tests and docs on plugin args and order. - - - - - 3e209a62 by MaxHearnden at 2022-04-01T11:05:19+01:00 Change may not to might not - - - - - b84380d3 by Matthew Pickering at 2022-04-01T11:07:27+01:00 hadrian: Remove linters-common from bindist Zubin observed that the bindists contains the utility library linters-common. There are two options: 1. Make sure only the right files are added into the bindist.. a bit tricky due to the non-trivial structure of the lib directory. 2. Remove the bad files once they get copied in.. a bit easier So I went for option 2 but we perhaps should go for option 1 in the future. Fixes #21203 - - - - - ba9904c1 by Zubin Duggal at 2022-04-01T11:07:31+01:00 hadrian: allow testing linters with out of tree compilers - - - - - 26547759 by Matthew Pickering at 2022-04-01T11:07:35+01:00 hadrian: Introduce CheckProgram datatype to replace a 7-tuple - - - - - df65d732 by Jakob Bruenker at 2022-04-01T11:08:28+01:00 Fix panic when pretty printing HsCmdLam When pretty printing a HsCmdLam with more than one argument, GHC panicked because of a missing case. This fixes that. Closes #21300 - - - - - ad6cd165 by John Ericson at 2022-04-01T11:10:06+01:00 hadrian: Remove vestigial -this-unit-id support check This has been dead code since 400ead81e80f66ad7b1260b11b2a92f25ccc3e5a. - - - - - 8ca7ab81 by Matthew Pickering at 2022-04-01T11:10:23+01:00 hadrian: Fix race involving empty package databases There was a small chance of a race occuring between the small window of 1. The first package (.conf) file get written into the database 2. hadrian calling "ghc-pkg recache" to refresh the package.conf file In this window the package database would contain rts.conf but not a package.cache file, and therefore if ghc was invoked it would error because it was missing. To solve this we call "ghc-pkg recache" at when the database is created by shake by writing the stamp file into the database folder. This also creates the package.cache file and so avoids the possibility of this race. - - - - - cc4ec64b by Matthew Pickering at 2022-04-01T11:11:05+01:00 hadrian: Add assertion that in/out tree args are the same There have been a few instances where this calculation was incorrect, so we add a non-terminal assertion when now checks they the two computations indeed compute the same thing. Fixes #21285 - - - - - 691508d8 by Matthew Pickering at 2022-04-01T11:13:10+01:00 hlint: Ignore suggestions in generated HaddockLex file With the make build system this file ends up in the compiler/ subdirectory so is linted. With hadrian, the file ends up in _build so it's not linted. Fixes #21313 - - - - - f8f152e7 by Krzysztof Gogolewski at 2022-04-01T11:14:08+01:00 Change GHC.Prim to GHC.Exts in docs and tests Users are supposed to import GHC.Exts rather than GHC.Prim. Part of #18749. - - - - - f8fc6d2e by Matthew Pickering at 2022-04-01T11:15:24+01:00 driver: Improve -Wunused-packages error message (and simplify implementation) In the past I improved the part of -Wunused-packages which found which packages were used. Now I improve the part which detects which ones were specified. The key innovation is to use the explicitUnits field from UnitState which has the result of resolving the package flags, so we don't need to mess about with the flag arguments from DynFlags anymore. The output now always includes the package name and version (and the flag which exposed it). ``` The following packages were specified via -package or -package-id flags, but were not needed for compilation: - bytestring-0.11.2.0 (exposed by flag -package bytestring) - ghc-9.3 (exposed by flag -package ghc) - process-1.6.13.2 (exposed by flag -package process) ``` Fixes #21307 - - - - - 5e5a12d9 by Matthew Pickering at 2022-04-01T11:15:32+01:00 driver: In oneshot mode, look for interface files in hidir How things should work: * -i is the search path for source files * -hidir explicitly sets the search path for interface files and the output location for interface files. * -odir sets the search path and output location for object files. Before in one shot mode we would look for the interface file in the search locations given by `-i`, but then set the path to be in the `hidir`, so in unusual situations the finder could find an interface file in the `-i` dir but later fail because it tried to read the interface file from the `-hidir`. A bug identified by #20569 - - - - - 950f58e7 by Matthew Pickering at 2022-04-01T11:15:36+01:00 docs: Update documentation interaction of search path, -hidir and -c mode. As noted in #20569 the documentation for search path was wrong because it seemed to indicate that `-i` dirs were important when looking for interface files in `-c` mode, but they are not important if `-hidir` is set. Fixes #20569 - - - - - d85c7dcb by sheaf at 2022-04-01T11:17:56+01:00 Keep track of promotion ticks in HsOpTy This patch adds a PromotionFlag field to HsOpTy, which is used in pretty-printing and when determining whether to emit warnings with -fwarn-unticked-promoted-constructors. This allows us to correctly report tick-related warnings for things like: type A = Int : '[] type B = [Int, Bool] Updates haddock submodule Fixes #19984 - - - - - 32070e6c by Jakob Bruenker at 2022-04-01T20:31:08+02:00 Implement \cases (Proposal 302) This commit implements proposal 302: \cases - Multi-way lambda expressions. This adds a new expression heralded by \cases, which works exactly like \case, but can match multiple apats instead of a single pat. Updates submodule haddock to support the ITlcases token. Closes #20768 - - - - - c6f77f39 by sheaf at 2022-04-01T20:33:05+02:00 Add a regression test for #21323 This bug was fixed at some point between GHC 9.0 and GHC 9.2; this patch simply adds a regression test. - - - - - 3596684e by Jakob Bruenker at 2022-04-01T20:33:05+02:00 Fix error when using empty case in arrow notation It was previously not possible to use -XEmptyCase in Arrow notation, since GHC would print "Exception: foldb of empty list". This is now fixed. Closes #21301 - - - - - 9a325b59 by Ben Gamari at 2022-04-01T20:33:05+02:00 users-guide: Fix various markup issues - - - - - aefb1e6d by sheaf at 2022-04-01T20:36:01+02:00 Ensure implicit parameters are lifted `tcExpr` typechecked implicit parameters by introducing a metavariable of kind `TYPE kappa`, without enforcing that `kappa ~ LiftedRep`. This patch instead creates a metavariable of kind `Type`. Fixes #21327 - - - - - ed62dc66 by Ben Gamari at 2022-04-05T11:44:51-04:00 gitlab-ci: Disable cabal-install store caching on Windows For reasons that remain a mystery, cabal-install seems to consistently corrupt its cache on Windows. Disable caching for now. Works around #21347. - - - - - 5ece5c5a by Ryan Scott at 2022-04-06T13:00:51-04:00 Add /linters/*/dist-install/ to .gitignore Fixes #21335. [ci skip] - - - - - 410c76ee by Ben Gamari at 2022-04-06T13:01:28-04:00 Use static archives as an alternative to object merging Unfortunately, `lld`'s COFF backend does not currently support object merging. With ld.bfd having broken support for high image-load base addresses, it's necessary to find an alternative. Here I introduce support in the driver for generating static archives, which we use on Windows instead of object merging. Closes #21068. - - - - - 400666c8 by Ben Gamari at 2022-04-06T13:01:28-04:00 rts/linker: Catch archives masquerading as object files Check the file's header to catch static archive bearing the `.o` extension, as may happen on Windows after the Clang refactoring. See #21068 - - - - - 694d39f0 by Ben Gamari at 2022-04-06T13:01:28-04:00 driver: Make object merging optional On Windows we don't have a linker which supports object joining (i.e. the `-r` flag). Consequently, `-pgmlm` is now a `Maybe`. See #21068. - - - - - 41fcb5cd by Ben Gamari at 2022-04-06T13:01:28-04:00 hadrian: Refactor handling of ar flags Previously the setup was quite fragile as it had to assume which arguments were file arguments and which were flags. - - - - - 3ac80a86 by Ben Gamari at 2022-04-06T13:01:28-04:00 hadrian: Produce ar archives with L modifier on Windows Since object files may in fact be archive files, we must ensure that their contents are merged rather than constructing an archive-of-an-archive. See #21068. - - - - - 295c35c5 by Ben Gamari at 2022-04-06T13:01:28-04:00 Add a Note describing lack of object merging on Windows See #21068. - - - - - d2ae0a3a by Ben Gamari at 2022-04-06T13:01:28-04:00 Build ar archives with -L when "joining" objects Since there may be .o files which are in fact archives. - - - - - babb47d2 by Zubin Duggal at 2022-04-06T13:02:04-04:00 Add warnings for file header pragmas that appear in the body of a module (#20385) Once we are done parsing the header of a module to obtain the options, we look through the rest of the tokens in order to determine if they contain any misplaced file header pragmas that would usually be ignored, potentially resulting in bad error messages. The warnings are reported immediately so that later errors don't shadow over potentially helpful warnings. Metric Increase: T13719 - - - - - 3f31825b by Ben Gamari at 2022-04-06T13:02:40-04:00 rts/AdjustorPool: Generalize to allow arbitrary contexts Unfortunately the i386 adjustor logic needs this. - - - - - 9b645ee1 by Ben Gamari at 2022-04-06T13:02:40-04:00 adjustors/i386: Use AdjustorPool In !7511 (closed) I introduced a new allocator for adjustors, AdjustorPool, which eliminates the address space fragmentation issues which adjustors can introduce. In that work I focused on amd64 since that was the platform where I observed issues. However, in #21132 we noted that the size of adjustors is also a cause of CI fragility on i386. In this MR I port i386 to use AdjustorPool. Sadly the complexity of the i386 adjustor code does cause require a bit of generalization which makes the code a bit more opaque but such is the world. Closes #21132. - - - - - c657a616 by Ben Gamari at 2022-04-06T13:03:16-04:00 hadrian: Clean up flavour transformer definitions Previously the `ipe` and `omit_pragmas` transformers were hackily defined using the textual key-value syntax. Fix this. - - - - - 9ce273b9 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab-ci: Drop dead HACKAGE_INDEX_STATE variable - - - - - 01845375 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab/darwin: Factor out bindists This makes it a bit easier to bump them. - - - - - c41c478e by Ben Gamari at 2022-04-06T13:03:16-04:00 Fix a few new warnings when booting with GHC 9.2.2 -Wuni-incomplete-patterns and apparent improvements in the pattern match checker surfaced these. - - - - - 6563cd24 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab-ci: Bump bootstrap compiler to 9.2.2 This is necessary to build recent `text` commits. Bumps Hackage index state for a hashable which builds with GHC 9.2. - - - - - a62e983e by Ben Gamari at 2022-04-06T13:03:16-04:00 Bump text submodule to current `master` Addresses #21295. - - - - - 88d61031 by Vladislav Zavialov at 2022-04-06T13:03:53-04:00 Refactor OutputableBndrFlag instances The matching on GhcPass introduced by 95275a5f25a is not necessary. This patch reverts it to make the code simpler. - - - - - f601f002 by GHC GitLab CI at 2022-04-06T15:18:26-04:00 rts: Eliminate use of nested functions This is a gcc-specific extension. - - - - - d4c5f29c by Ben Gamari at 2022-04-06T15:18:26-04:00 driver: Drop hacks surrounding windres invocation Drop hack for #1828, among others as they appear to be unnecessary when using `llvm-windres`. - - - - - 6be2c5a7 by Ben Gamari at 2022-04-06T15:18:26-04:00 Windows/Clang: Build system adaptation * Bump win32-tarballs to 0.7 * Move Windows toolchain autoconf logic into separate file * Use clang and LLVM utilities as described in #21019 * Disable object merging as lld doesn't support -r * Drop --oformat=pe-bigobj-x86-64 arguments from ld flags as LLD detects that the output is large on its own. * Drop gcc wrapper since Clang finds its root fine on its own. - - - - - c6fb7aff by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Test that we can build bigobj PE objects - - - - - 79851c07 by Ben Gamari at 2022-04-06T15:18:26-04:00 Drop -static-libgcc This flag is not applicable when Clang is used. - - - - - 1f8a8264 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Port T16514 to C Previously this test was C++ which made it a bit of a portability problem. - - - - - d7e650d1 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark Windows as a libc++ platform - - - - - d7886c46 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark T9405 as fixed on Windows I have not seen it fail since moving to clang. Closes #12714. - - - - - 4c3fbb4e by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark FloatFnInverses as fixed The new toolchain has fixed it. Closes #15670. - - - - - 402c36ba by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Rework T13606 to avoid gcc dependence Previously we used libgcc_s's import library in T13606. However, now that we ship with clang we no longer have this library. Instead we now use gdi32. - - - - - 9934ad54 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Clean up tests depending on C++ std lib - - - - - 12fcdef2 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Split T13366 into two tests Split up the C and C++ uses since the latter is significantly more platform-dependent. - - - - - 3c08a198 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Fix mk-big-obj I'm a bit unclear on how this previously worked as it attempted to build an executable without defining `main`. - - - - - 7e97cc23 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Provide module definitions in T10955dyn Otherwise the linker will export all symbols, including those provided by the RTS, from the produced shared object. Consequently, attempting to link against multiple objects simultaneously will cause the linker to complain that RTS symbols are multiply defined. Avoid this by limiting the DLL exports with a module definition file. - - - - - 9a248afa by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark test-defaulting-plugin as fragile on Windows Currently llvm-ar does not handle long file paths, resulting in occassional failures of these tests and #21293. - - - - - 39371aa4 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite/driver: Treat framework failures of fragile tests as non-fatal Previously we would report framework failures of tests marked as fragile as failures. Now we rather treat them as fragile test failures, which are not fatal to the testsuite run. Noticed while investigating #21293. - - - - - a1e6661d by Ben Gamari at 2022-04-06T15:18:32-04:00 Bump Cabal submodule - Disable support for library-for-ghci on Windows as described in #21068. - Teach Cabal to use `ar -L` when available - - - - - f7b0f63c by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump process submodule Fixes missing TEST_CC_OPTS in testsuite tests. - - - - - 109cee19 by Ben Gamari at 2022-04-06T15:18:37-04:00 hadrian: Disable ghci libraries when object merging is not available - - - - - c22fba5c by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump bytestring submodule - - - - - 6e2744cc by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump text submodule - - - - - 32333747 by Ben Gamari at 2022-04-06T15:18:37-04:00 hadrian: Build wrappers using ghc rather than cc - - - - - 59787ba5 by Ben Gamari at 2022-04-06T15:18:37-04:00 linker/PEi386: More descriptive error message - - - - - 5e3c3c4f by Ben Gamari at 2022-04-06T15:18:37-04:00 testsuite: Mark TH_spliceE5_prof as unbroken on Windows It was previously failing due to #18721 and now passes with the new toolchain. Closes #18721. - - - - - 9eb0a9d9 by GHC GitLab CI at 2022-04-06T15:23:48-04:00 rts/PEi386: Move some debugging output to -DL - - - - - ce874595 by Ben Gamari at 2022-04-06T15:24:01-04:00 nativeGen/x86: Use %rip-relative addressing On Windows with high-entropy ASLR we must use %rip-relative addressing to avoid overflowing the signed 32-bit immediate size of x86-64. Since %rip-relative addressing comes essentially for free and can make linking significantly easier, we use it on all platforms. - - - - - 52deee64 by Ben Gamari at 2022-04-06T15:24:01-04:00 Generate LEA for label expressions - - - - - 105a0056 by Ben Gamari at 2022-04-06T15:24:01-04:00 Refactor is32BitLit to take Platform rather than Bool - - - - - ec4526b5 by Ben Gamari at 2022-04-06T15:24:01-04:00 Don't assume that labels are 32-bit on Windows - - - - - ffdbe457 by Ben Gamari at 2022-04-06T15:24:01-04:00 nativeGen: Note signed-extended nature of MOV - - - - - bfb79697 by Ben Gamari at 2022-04-06T15:30:56-04:00 rts: Move __USE_MINGW_ANSI_STDIO definition to PosixSource.h It's easier to ensure that this is included first than Rts.h - - - - - 5ad143fd by Ben Gamari at 2022-04-06T15:30:56-04:00 rts: Fix various #include issues This fixes various violations of the newly-added RTS includes linter. - - - - - a59a66a8 by Ben Gamari at 2022-04-06T15:30:56-04:00 testsuite: Lint RTS #includes Verifies two important properties of #includes in the RTS: * That system headers don't appear inside of a `<BeginPrivate.h>` block as this can hide system library symbols, resulting in very hard-to-diagnose linker errors * That no headers precede `Rts.h`, ensuring that __USE_MINGW_ANSI_STDIO is set correctly before system headers are included. - - - - - 42bf7528 by GHC GitLab CI at 2022-04-06T16:25:04-04:00 rts/PEi386: Fix memory leak Previously we would leak the section information of the `.bss` section. - - - - - d286a55c by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Preserve information about symbol types As noted in #20978, the linker would previously handle overflowed relocations by creating a jump island. While this is fine in the case of code symbols, it's very much not okay in the case of data symbols. To fix this we must keep track of whether each symbol is code or data and relocate them appropriately. This patch takes the first step in this direction, adding a symbol type field to the linker's symbol table. It doesn't yet change relocation behavior to take advantage of this knowledge. Fixes #20978. - - - - - e689e9d5 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Fix relocation overflow behavior This fixes handling of overflowed relocations on PEi386 targets: * Refuse to create jump islands for relocations of data symbols * Correctly handle the `__imp___acrt_iob_func` symbol, which is an new type of symbol: `SYM_TYPE_INDIRECT_DATA` - - - - - 655e7d8f by GHC GitLab CI at 2022-04-06T16:25:25-04:00 rts: Mark anything that might have an info table as data Tables-next-to-code mandates that we treat symbols with info tables like data since we cannot relocate them using a jump island. See #20983. - - - - - 7e8cc293 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Rework linker This is a significant rework of the PEi386 linker, making the linker compatible with high image base addresses. Specifically, we now use the m32 allocator instead of `HeapAllocate`. In addition I found a number of latent bugs in our handling of import libraries and relocations. I've added quite a few comments describing what I've learned about Windows import libraries while fixing these. Thanks to Tamar Christina (@Phyx) for providing the address space search logic, countless hours of help while debugging, and his boundless Windows knowledge. Co-Authored-By: Tamar Christina <tamar at zhox.com> - - - - - ff625218 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Move allocateBytes to MMap.c - - - - - f562b5ca by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Avoid accidentally-quadratic allocation cost We now preserve the address that we last mapped, allowing us to resume our search and avoiding quadratic allocation costs. This fixes the runtime of T10296a, which allocates many adjustors. - - - - - 3247b7db by Ben Gamari at 2022-04-06T16:25:25-04:00 Move msvcrt dep out of base - - - - - fa404335 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: More descriptive debug output - - - - - 140f338f by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PathUtils: Define pathprintf in terms of snwprintf on Windows swprintf deviates from usual `snprintf` semantics in that it does not guarantee reasonable behavior when the buffer is NULL (that is, returning the number of bytes that would have been emitted). - - - - - eb60565b by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Report archive member index - - - - - 209fd61b by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Split up object resolution and initialization Previously the RTS linker would call initializers during the "resolve" phase of linking. However, this is problematic in the case of cyclic dependencies between objects. In particular, consider the case where we have a situation where a static library contains a set of recursive objects: * object A has depends upon symbols in object B * object B has an initializer that depends upon object A * we try to load object A The linker would previously: 1. start resolving object A 2. encounter the reference to object B, loading it resolve object B 3. run object B's initializer 4. the initializer will attempt to call into object A, which hasn't been fully resolved (and therefore protected) Fix this by moving constructor execution to a new linking phase, which follows resolution. Fix #21253. - - - - - 8e8a1021 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker/LoadArchive: Fix leaking file handle Previously `isArchive` could leak a `FILE` handle if the `fread` returned a short read. - - - - - 429ea5d9 by sheaf at 2022-04-07T07:55:52-04:00 Remove Fun pattern from Typeable COMPLETE set GHC merge request !963 improved warnings in the presence of COMPLETE annotations. This allows the removal of the Fun pattern from the complete set. Doing so expectedly causes some redundant pattern match warnings, in particular in GHC.Utils.Binary.Typeable and Data.Binary.Class from the binary library; this commit addresses that. Updates binary submodule Fixes #20230 - - - - - 54b18824 by Alan Zimmerman at 2022-04-07T07:56:28-04:00 EPA: handling of con_bndrs in mkGadtDecl Get rid of unnnecessary case clause that always matched. Closes #20558 - - - - - 9c838429 by Ben Gamari at 2022-04-07T09:38:53-04:00 testsuite: Mark T10420 as broken on Windows Due to #21322. - - - - - 50739d2b by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Refactor and fix printf attributes on clang Clang on Windows does not understand the `gnu_printf` attribute; use `printf` instead. - - - - - 9eeaeca4 by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Add missing newline in error message - - - - - fcef9a17 by Ben Gamari at 2022-04-07T09:42:42-04:00 configure: Make environ decl check more robust Some platforms (e.g. Windows/clang64) declare `environ` in `<stdlib.h>`, not `<unistd.h>` - - - - - 8162b4f3 by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Adjust RTS symbol table on Windows for ucrt - - - - - 633280d7 by Ben Gamari at 2022-04-07T09:43:21-04:00 testsuite: Fix exit code of bounds checking tests on Windows `abort` exits with 255, not 134, on Windows. - - - - - cab4dc01 by Ben Gamari at 2022-04-07T09:43:31-04:00 testsuite: Update expected output from T5435 tests on Windows I'll admit, I don't currently see *why* this output is reordered but it is a fairly benign difference and I'm out of time to investigate. - - - - - edf5134e by Ben Gamari at 2022-04-07T09:43:35-04:00 testsuite: Mark T20918 as broken on Windows Our toolchain on Windows doesn't currently have Windows support. - - - - - d0ddeff3 by Ben Gamari at 2022-04-07T09:43:39-04:00 testsuite: Mark linker unloading tests as broken on Windows Due to #20354. We will need to investigate this prior the release. - - - - - 5a86da2b by Ben Gamari at 2022-04-07T09:43:43-04:00 testsuite: Mark T9405 as broken on Windows Due to #21361. - - - - - 4aa86dcf by Ben Gamari at 2022-04-07T09:44:18-04:00 Merge branches 'wip/windows-high-codegen', 'wip/windows-high-linker', 'wip/windows-clang-2' and 'wip/lint-rts-includes' into wip/windows-clang-join - - - - - 7206f055 by Ben Gamari at 2022-04-07T09:45:07-04:00 rts/CloneStack: Ensure that Rts.h is #included first As is necessary on Windows. - - - - - 9cfcb27b by Ben Gamari at 2022-04-07T09:45:07-04:00 rts: Fallback to ucrtbase not msvcrt Since we have switched to Clang the toolchain now links against ucrt rather than msvcrt. - - - - - d6665d85 by Ben Gamari at 2022-04-07T09:46:25-04:00 Accept spurious perf test shifts on Windows Metric Decrease: T16875 Metric Increase: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 83363c8b by Simon Peyton Jones at 2022-04-07T12:57:21-04:00 Use prepareBinding in tryCastWorkerWrapper As #21144 showed, tryCastWorkerWrapper was calling prepareRhs, and then unconditionally floating the bindings, without the checks of doFloatFromRhs. That led to floating an unlifted binding into a Rec group. This patch refactors prepareBinding to make these checks, and do them uniformly across all calls. A nice improvement. Other changes * Instead of passing around a RecFlag and a TopLevelFlag; and sometimes a (Maybe SimplCont) for join points, define a new Simplifier-specific data type BindContext: data BindContext = BC_Let TopLevelFlag RecFlag | BC_Join SimplCont and use it consistently. * Kill off completeNonRecX by inlining it. It was only called in one place. * Add a wrapper simplImpRules for simplRules. Compile time on T9630 drops by 4.7%; little else changes. Metric Decrease: T9630 - - - - - 02279a9c by Vladislav Zavialov at 2022-04-07T12:57:59-04:00 Rename [] to List (#21294) This patch implements a small part of GHC Proposal #475. The key change is in GHC.Types: - data [] a = [] | a : [a] + data List a = [] | a : List a And the rest of the patch makes sure that List is pretty-printed as [] in various contexts. Updates the haddock submodule. - - - - - 08480d2a by Simon Peyton Jones at 2022-04-07T12:58:36-04:00 Fix the free-var test in validDerivPred The free-var test (now documented as (VD3)) was too narrow, affecting only class predicates. #21302 demonstrated that this wasn't enough! Fixes #21302. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - b3d6d23d by Andreas Klebinger at 2022-04-07T12:59:12-04:00 Properly explain where INLINE pragmas can appear. Fixes #20676 - - - - - 23ef62b3 by Ben Gamari at 2022-04-07T14:28:28-04:00 rts: Fix off-by-one in snwprintf usage - - - - - b2dbcc7d by Simon Jakobi at 2022-04-08T03:00:38-04:00 Improve seq[D]VarSet Previously, the use of size[D]VarSet would involve a traversal of the entire underlying IntMap. Since IntMaps are already spine-strict, this is unnecessary. - - - - - 64ac20a7 by sheaf at 2022-04-08T03:01:16-04:00 Add test for #21338 This no-skolem-info bug was fixed by the no-skolem-info patch that will be part of GHC 9.4. This patch adds a regression test for the issue reported in issue #21338. Fixes #21338. - - - - - c32c4db6 by Ben Gamari at 2022-04-08T03:01:53-04:00 rts: Move __USE_MINGW_ANSI_STDIO definition to PosixSource.h It's easier to ensure that this is included first than Rts.h - - - - - 56f85d62 by Ben Gamari at 2022-04-08T03:01:53-04:00 rts: Fix various #include issues This fixes various violations of the newly-added RTS includes linter. - - - - - cb1f31f5 by Ben Gamari at 2022-04-08T03:01:53-04:00 testsuite: Lint RTS #includes Verifies two important properties of #includes in the RTS: * That system headers don't appear inside of a `<BeginPrivate.h>` block as this can hide system library symbols, resulting in very hard-to-diagnose linker errors * That no headers precede `Rts.h`, ensuring that __USE_MINGW_ANSI_STDIO is set correctly before system headers are included. - - - - - c44432db by Krzysztof Gogolewski at 2022-04-08T03:02:29-04:00 Fixes to 9.4 release notes - Mention -Wforall-identifier - Improve description of withDict - Fix formatting - - - - - 777365f1 by sheaf at 2022-04-08T09:43:35-04:00 Correctly report SrcLoc of redundant constraints We were accidentally dropping the source location information in certain circumstances when reporting redundant constraints. This patch makes sure that we set the TcLclEnv correctly before reporting the warning. Fixes #21315 - - - - - af300a43 by Vladislav Zavialov at 2022-04-08T09:44:11-04:00 Reject illegal quote mark in data con declarations (#17865) * Non-fatal (i.e. recoverable) parse error * Checking infix constructors * Extended the regression test - - - - - 56254e6b by Ben Gamari at 2022-04-08T09:59:46-04:00 Merge remote-tracking branch 'origin/master' - - - - - 6e2c3b7c by Matthew Pickering at 2022-04-08T13:55:15-04:00 driver: Introduce HomeModInfoCache abstraction The HomeModInfoCache is a mutable cache which is updated incrementally as the driver completes, this makes it robust to exceptions including (SIGINT) The interface for the cache is described by the `HomeMOdInfoCache` data type: ``` data HomeModInfoCache = HomeModInfoCache { hmi_clearCache :: IO [HomeModInfo] , hmi_addToCache :: HomeModInfo -> IO () } ``` The first operation clears the cache and returns its contents. This is designed so it's harder to end up in situations where the cache is retained throughout the execution of upsweep. The second operation allows a module to be added to the cache. The one slightly nasty part is in `interpretBuildPlan` where we have to be careful to ensure that the cache writes happen: 1. In parralel 2. Before the executation continues after upsweep. This requires some simple, localised MVar wrangling. Fixes #20780 - - - - - 85f4a3c9 by Andreas Klebinger at 2022-04-08T13:55:50-04:00 Add flag -fprof-manual which controls if GHC should honour manual cost centres. This allows disabling of manual control centres in code a user doesn't control like libraries. Fixes #18867 - - - - - 3415981c by Vladislav Zavialov at 2022-04-08T13:56:27-04:00 HsUniToken for :: in GADT constructors (#19623) One more step towards the new design of EPA. Updates the haddock submodule. - - - - - 23f95735 by sheaf at 2022-04-08T13:57:07-04:00 Docs: datacon eta-expansion, rep-poly checks The existing notes weren't very clear on how the eta-expansion of data constructors that occurs in tcInferDataCon/dsConLike interacts with the representation polymorphism invariants. So we explain with a few more details how we ensure that the representation-polymorphic lambdas introduced by tcInferDataCon/dsConLike don't end up causing problems, by checking they are properly instantiated and then relying on the simple optimiser to perform beta reduction. A few additional changes: - ConLikeTc just take type variables instead of binders, as we never actually used the binders. - Removed the FRRApp constructor of FRROrigin; it was no longer used now that we use ExpectedFunTyOrigin. - Adds a bit of documentation to the constructors of ExpectedFunTyOrigin. - - - - - d4480490 by Matthew Pickering at 2022-04-08T13:57:43-04:00 ci: Replace "always" with "on_success" to stop build jobs running before hadrian-ghci has finished See https://docs.gitlab.com/ee/ci/yaml/#when * always means, always run not matter what * on_success means, run if the dependencies have built successfully - - - - - 0736e949 by Vladislav Zavialov at 2022-04-08T13:58:19-04:00 Disallow (->) as a data constructor name (#16999) The code was misusing isLexCon, which was never meant for validation. In fact, its documentation states the following: Use these functions to figure what kind of name a 'FastString' represents; these functions do /not/ check that the identifier is valid. Ha! This sign can't stop me because I can't read. The fix is to use okConOcc instead. The other checks (isTcOcc or isDataOcc) seem superfluous, so I also removed those. - - - - - e58d5eeb by Simon Peyton Jones at 2022-04-08T13:58:55-04:00 Tiny documentation wibble This commit commit 83363c8b04837ee871a304cf85207cf79b299fb0 Author: Simon Peyton Jones <simon.peytonjones at gmail.com> Date: Fri Mar 11 16:55:38 2022 +0000 Use prepareBinding in tryCastWorkerWrapper refactored completeNonRecX away, but left a Note referring to it. This MR fixes that Note. - - - - - 4bb00839 by Matthew Pickering at 2022-04-09T07:40:28-04:00 ci: Fix nightly head.hackage pipelines This also needs a corresponding commit to head.hackage, I also made the job explicitly depend on the fedora33 job so that it isn't blocked by a failing windows job, which causes docs-tarball to fail. - - - - - 3c48e12a by Matthew Pickering at 2022-04-09T07:40:28-04:00 ci: Remove doc-tarball dependency from perf and perf-nofib jobs These don't depend on the contents of the tarball so we can run them straight after the fedora33 job finishes. - - - - - 27362265 by Matthew Pickering at 2022-04-09T07:41:04-04:00 Bump deepseq to 1.4.7.0 Updates deepseq submodule Fixes #20653 - - - - - dcf30da8 by Joachim Breitner at 2022-04-09T13:02:19-04:00 Drop the app invariant previously, GHC had the "let/app-invariant" which said that the RHS of a let or the argument of an application must be of lifted type or ok for speculation. We want this on let to freely float them around, and we wanted that on app to freely convert between the two (e.g. in beta-reduction or inlining). However, the app invariant meant that simple code didn't stay simple and this got in the way of rules matching. By removing the app invariant, this thus fixes #20554. The new invariant is now called "let-can-float invariant", which is hopefully easier to guess its meaning correctly. Dropping the app invariant means that everywhere where we effectively do beta-reduction (in the two simplifiers, but also in `exprIsConApp_maybe` and other innocent looking places) we now have to check if the argument must be evaluated (unlifted and side-effecting), and analyses have to be adjusted to the new semantics of `App`. Also, `LetFloats` in the simplifier can now also carry such non-floating bindings. The fix for DmdAnal, refine by Sebastian, makes functions with unlifted arguments strict in these arguments, which changes some signatures. This causes some extra calls to `exprType` and `exprOkForSpeculation`, so some perf benchmarks regress a bit (while others improve). Metric Decrease: T9020 Metric Increase: LargeRecord T12545 T15164 T16577 T18223 T5642 T9961 Co-authored-by: Sebastian Graf <sebastian.graf at kit.edu> - - - - - 6c6c5379 by Philip Hazelden at 2022-04-09T13:02:59-04:00 Add functions traceWith, traceShowWith, traceEventWith. As discussed at https://github.com/haskell/core-libraries-committee/issues/36 - - - - - 8fafacf7 by Philip Hazelden at 2022-04-09T13:02:59-04:00 Add tests for several trace functions. - - - - - 20bbf3ac by Philip Hazelden at 2022-04-09T13:02:59-04:00 Update changelog. - - - - - 47d18b0b by Andreas Klebinger at 2022-04-09T13:03:35-04:00 Add regression test for #19569 - - - - - 5f8d6e65 by sheaf at 2022-04-09T13:04:14-04:00 Fix missing SymCo in pushCoercionIntoLambda There was a missing SymCo in pushCoercionIntoLambda. Currently this codepath is only used with rewrite rules, so this bug managed to slip by, but trying to use pushCoercionIntoLambda in other contexts revealed the bug. - - - - - 20eca489 by Vladislav Zavialov at 2022-04-09T13:04:50-04:00 Refactor: simplify lexing of the dot Before this patch, the lexer did a truly roundabout thing with the dot: 1. look up the varsym in reservedSymsFM and turn it into ITdot 2. under OverloadedRecordDot, turn it into ITvarsym 3. in varsym_(prefix|suffix|...) turn it into ITvarsym, ITdot, or ITproj, depending on extensions and whitespace Turns out, the last step is sufficient to handle the dot correctly. This patch removes the first two steps. - - - - - 5440f63e by Hécate Moonlight at 2022-04-12T11:11:06-04:00 Document that DuplicateRecordFields doesn't tolerates ambiguous fields Fix #19891 - - - - - 0090ad7b by Sebastian Graf at 2022-04-12T11:11:42-04:00 Eta reduction based on evaluation context (#21261) I completely rewrote our Notes surrounding eta-reduction. The new entry point is `Note [Eta reduction makes sense]`. Then I went on to extend the Simplifier to maintain an evaluation context in the form of a `SubDemand` inside a `SimplCont`. That `SubDemand` is useful for doing eta reduction according to `Note [Eta reduction based on evaluation context]`, which describes how Demand analysis, Simplifier and `tryEtaReduce` interact to facilitate eta reduction in more scenarios. Thus we fix #21261. ghc/alloc perf marginally improves (-0.0%). A medium-sized win is when compiling T3064 (-3%). It seems that haddock improves by 0.6% to 1.0%, too. Metric Decrease: T3064 - - - - - 4d2ee313 by Sebastian Graf at 2022-04-12T17:54:57+02:00 Specialising through specialised method calls (#19644) In #19644, we discovered that the ClassOp/DFun rules from Note [ClassOp/DFun selection] inhibit transitive specialisation in a scenario like ``` class C a where m :: Show b => a -> b -> ...; n :: ... instance C Int where m = ... -- $cm :: Show b => Int -> b -> ... f :: forall a b. (C a, Show b) => ... f $dC $dShow = ... m @a $dC @b $dShow ... main = ... f @Int @Bool ... ``` After we specialise `f` for `Int`, we'll see `m @a $dC @b $dShow` in the body of `$sf`. But before this patch, Specialise doesn't apply the ClassOp/DFun rule to rewrite to a call of the instance method for `C Int`, e.g., `$cm @Bool $dShow`. As a result, Specialise couldn't further specialise `$cm` for `Bool`. There's a better example in `Note [Specialisation modulo dictionary selectors]`. This patch enables proper Specialisation, as follows: 1. In the App case of `specExpr`, try to apply the CalssOp/DictSel rule on the head of the application 2. Attach an unfolding to freshly-bound dictionary ids such as `$dC` and `$dShow` in `bindAuxiliaryDict` NB: Without (2), (1) would be pointless, because `lookupRule` wouldn't be able to look into the RHS of `$dC` to see the DFun. (2) triggered #21332, because the Specialiser floats around dictionaries without accounting for them in the `SpecEnv`'s `InScopeSet`, triggering a panic when rewriting dictionary unfoldings. Fixes #19644 and #21332. - - - - - b06f4f47 by Sebastian Graf at 2022-04-12T17:54:58+02:00 Specialise: Check `typeDeterminesValue` before specialising on an interesting dictionary I extracted the checks from `Note [Type determines value]` into its own function, so that we share the logic properly. Then I made sure that we actually call `typeDeterminesValue` everywhere we check for `interestingDict`. - - - - - a42dbc55 by Matthew Pickering at 2022-04-13T06:24:52-04:00 Refine warning about defining rules in SAFE modules This change makes it clear that it's the definition rather than any usage which is a problem, and that rules defined in other modules will still be used to do rewrites. Fixes #20923 - - - - - df893f66 by Andreas Klebinger at 2022-04-14T08:18:37-04:00 StgLint: Lint constructor applications and strict workers for arity. This will mean T9208 when run with lint will return a lint error instead of resulting in a panic. Fixes #21117 - - - - - 426ec446 by sheaf at 2022-04-14T08:19:16-04:00 Hadrian: use a set to keep track of ways The order in which ways are provided doesn't matter, so we use a data structure with the appropriate semantics to represent ways. Fixes #21378 - - - - - 7c639b9a by Dylan Yudaken at 2022-04-15T13:55:59-04:00 Only enable PROF_SPIN in DEBUG - - - - - 96b9e5ea by Ben Gamari at 2022-04-15T13:56:34-04:00 testsuite: Add test for #21390 - - - - - d8392f6a by Ben Gamari at 2022-04-15T13:56:34-04:00 rts: Ensure that the interpreter doesn't disregard tags Previously the interpreter's handling of `RET_BCO` stack frames would throw away the tag of the returned closure. This resulted in #21390. - - - - - 83c67f76 by Alan Zimmerman at 2022-04-20T11:49:28-04:00 Add -dkeep-comments flag to keep comments in the parser This provides a way to set the Opt_KeepRawTokenStream from the command line, allowing exact print annotation users to see exactly what is produced for a given parsed file, when used in conjunction with -ddump-parsed-ast Discussed in #19706, but this commit does not close the issue. - - - - - a5ea65c9 by Krzysztof Gogolewski at 2022-04-20T11:50:04-04:00 Remove LevityInfo Every Id was storing a boolean whether it could be levity-polymorphic. This information is no longer needed since representation-checking has been moved to the typechecker. - - - - - 49bd7584 by Andreas Klebinger at 2022-04-20T11:50:39-04:00 Fix a shadowing issue in StgUnarise. For I assume performance reasons we don't record no-op replacements during unarise. This lead to problems with code like this: f = \(Eta_B0 :: VoidType) x1 x2 -> ... let foo = \(Eta_B0 :: LiftedType) -> g x y Eta_B0 in ... Here we would record the outer Eta_B0 as void rep, but would not shadow Eta_B0 inside `foo` because this arg is single-rep and so doesn't need to replaced. But this means when looking at occurence sites we would check the env and assume it's void rep based on the entry we made for the (no longer in scope) outer `Eta_B0`. Fixes #21396 and the ticket has a few more details. - - - - - 0c02c919 by Simon Peyton Jones at 2022-04-20T11:51:15-04:00 Fix substitution in bindAuxiliaryDict In GHC.Core.Opt.Specialise.bindAuxiliaryDict we were unnecessarily calling `extendInScope` to bring into scope variables that were /already/ in scope. Worse, GHC.Core.Subst.extendInScope strangely deleted the newly-in-scope variables from the substitution -- and that was fatal in #21391. I removed the redundant calls to extendInScope. More ambitiously, I changed GHC.Core.Subst.extendInScope (and cousins) to stop deleting variables from the substitution. I even changed the names of the function to extendSubstInScope (and cousins) and audited all the calls to check that deleting from the substitution was wrong. In fact there are very few such calls, and they are all about introducing a fresh non-in-scope variable. These are "OutIds"; it is utterly wrong to mess with the "InId" substitution. I have not added a Note, because I'm deleting wrong code, and it'd be distracting to document a bug. - - - - - 0481a6af by Cheng Shao at 2022-04-21T11:06:06+00:00 [ci skip] Drop outdated TODO in RtsAPI.c - - - - - 1e062a8a by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Introduce ip_STACK_FRAME While debugging it is very useful to be able to determine whether a given info table is a stack frame or not. We have spare bits in the closure flags array anyways, use one for this information. - - - - - 08a6a2ee by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Mark closureFlags array as const - - - - - 8f9b8282 by Krzysztof Gogolewski at 2022-04-22T02:13:35-04:00 Check for zero-bit types in sizeExpr Fixes #20940 Metric Decrease: T18698a - - - - - fcf22883 by Andreas Klebinger at 2022-04-22T02:14:10-04:00 Include the way string in the file name for dump files. This can be disabled by `-fno-dump-with-ways` if not desired. Finally we will be able to look at both profiled and non-profiled dumps when compiling with dump flags and we compile in both ways. - - - - - 252394ce by Andrew Lelechenko at 2022-04-22T02:14:48-04:00 Improve error messages from GHC.IO.Encoding.Failure - - - - - 250f57c1 by Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Gergő Érdi 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 Andrew Lelechenko 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 Gergő Érdi 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Matthew 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 Andrew Lelechenko 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 Matthew 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Gergő Érdi 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 Andrew Lelechenko 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 Matthew 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Andrew Lelechenko at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Andrew Lelechenko 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 Andrew Lelechenko 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 Andrew Lelechenko at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Andrew Lelechenko 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 Andrew Lelechenko at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Andrew Lelechenko at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Andrew Lelechenko at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Andrew Lelechenko at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Andrew Lelechenko at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Andrew Lelechenko at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Andrew Lelechenko 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 Andrew Lelechenko 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