- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/mp/iface-patches-9.10] Refactor the Binary serialisation interface
by Matthew Pickering (＠mpickering) 19 Dec '25

19 Dec '25

Matthew Pickering pushed to branch wip/mp/iface-patches-9.10 at Glasgow Haskell Compiler / GHC Commits: b15caeb0 by Fendor at 2025-12-19T09:43:37+00:00 Refactor the Binary serialisation interface The goal is simplifiy adding deduplication tables to `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 this refactoring, we split `UserData` into `ReaderUserData` and `WriterUserData`, to avoid partial functions and reduce overall memory usage, as we need fewer mutable variables. Bump haddock submodule to accomodate for `UserData` split. ------------------------- Metric Increase: MultiLayerModulesTH_Make MultiLayerModulesRecomp T21839c ------------------------- 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. Add Eq and Ord instance to `IfaceType` We add an `Ord` instance so that we can store `IfaceType` in a `Data.Map` container. This is required to deduplicate `IfaceType` while writing `.hi` files to disk. Deduplication has many beneficial consequences to both file size and memory usage, as the deduplication enables implicit sharing of values. See issue #24540 for more motivation. The `Ord` instance would be unnecessary if we used a `TrieMap` instead of `Data.Map` for the deduplication process. While in theory this is clerarly the better option, experiments on the agda code base showed that a `TrieMap` implementation has worse run-time performance characteristics. To the change itself, we mostly derive `Eq` and `Ord`. This requires us to change occurrences of `FastString` with `LexicalFastString`, since `FastString` has no `Ord` instance. We change the definition of `IfLclName` to a newtype of `LexicalFastString`, to make such changes in the future easier. Bump haddock submodule for IfLclName changes Move out LiteralMap to avoid cyclic module dependencies 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 when byte code is embedded into the `.hi` file via `-fwrite-if-simplified-core` or `-fbyte-code-and-object-code`. Loading such `.hi` files from disk introduces many duplicates of memory expensive values in `IfaceType`, such as `IfaceTyCon`, `IfaceTyConApp`, `IA_Arg` and many more. We improve the memory behaviour of GHCi by adding an additional deduplication table for `IfaceType` 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`. To provide some numbers, we evaluated this patch on the agda code base. We loaded the full library from the `.hi` files, which contained the embedded core expressions (`-fwrite-if-simplified-core`). Before this patch: * Load time: 11.7 s, 2.5 GB maximum residency. After this patch: * Load time: 7.3 s, 1.7 GB maximum residency. This deduplication has the beneficial side effect to additionally reduce the size of the on-disk interface files tremendously. For example, on agda, we reduce the size of `.hi` files (with `-fwrite-if-simplified-core`): * Before: 101 MB on disk * Now: 24 MB on disk This has even a beneficial side effect on the cabal store. We reduce the size of the store on disk: * Before: 341 MB on disk * Now: 310 MB on disk Note, none of the dependencies have been compiled with `-fwrite-if-simplified-core`, but `IfaceType` occurs in multiple locations in a `ModIface`. We also add IfaceType deduplication table to .hie serialisation and refactor .hie file serialisation to use the same infrastrucutre as `putWithTables`. Bump haddock submodule to accomodate for changes to the deduplication table layout and binary interface. Add run-time configurability of `.hi` file compression Introduce the flag `-fwrite-if-compression=<n>` which allows to configure the compression level of writing .hi files. The motivation is that some deduplication operations are too expensive for the average use case. Hence, we introduce multiple compression levels with variable impact on performance, but still reduce the memory residency and `.hi` file size on disk considerably. We introduce three compression levels: * `1`: `Normal` mode. This is the least amount of compression. It deduplicates only `Name` and `FastString`s, and is naturally the fastest compression mode. * `2`: `Safe` mode. It has a noticeable impact on .hi file size and is marginally slower than `Normal` mode. In general, it should be safe to always use `Safe` mode. * `3`: `Full` deduplication mode. Deduplicate as much as we can, resulting in minimal .hi files, but at the cost of additional compilation time. Reading .hi files doesn't need to know the initial compression level, and can always deserialise a `ModIface`, as we write out a byte that indicates the next value has been deduplicated. This allows users to experiment with different compression levels for packages, without recompilation of dependencies. Note, the deduplication also has an additional side effect of reduced memory consumption to implicit sharing of deduplicated elements. See https://gitlab.haskell.org/ghc/ghc/-/issues/24540 for example where that matters. ------------------------- Metric Decrease: MultiLayerModulesDefsGhciWithCore T16875 T21839c T24471 hard_hole_fits libdir ------------------------- Improve sharing of duplicated values in `ModIface`, fixes #24723 As a `ModIface` often contains duplicated values that are not necessarily shared, we improve sharing by serialising the `ModIface` to an in-memory byte array. Serialisation uses deduplication tables, and deserialisation implicitly shares duplicated values. This helps reducing the peak memory usage while compiling in `--make` mode. The peak memory usage is especially smaller when generating interface files with core expressions (`-fwrite-if-simplified-core`). On agda, this reduces the peak memory usage: * `2.2 GB` to `1.9 GB` for a ghci session. On `lib:Cabal`, we report: * `570 MB` to `500 MB` for a ghci session * `790 MB` to `667 MB` for compiling `lib:Cabal` with ghc There is a small impact on execution time, around 2% on the agda code base. Avoid unneccessarily re-serialising the `ModIface` To reduce memory usage of `ModIface`, we serialise `ModIface` to an in-memory byte array, which implicitly shares duplicated values. This serialised byte array can be reused to avoid work when we actually write the `ModIface` to disk. We introduce a new field to `ModIface` which allows us to save the byte array, and write it direclty to disk if the `ModIface` wasn't changed after the initial serialisation. This requires us to change absolute offsets, for example to jump to the deduplication table for `Name` or `FastString` with relative offsets, as the deduplication byte array doesn't contain header information, such as fingerprints. To allow us to dump the binary blob to disk, we need to replace all absolute offsets with relative ones. We introduce additional helpers for `ModIface` binary serialisation, which construct relocatable binary blobs. We say the binary blob is relocatable, if the binary representation can be moved and does not contain any absolute offsets. Further, we introduce new primitives for `Binary` that allow to create relocatable binaries, such as `forwardGetRel` and `forwardPutRel`. ------------------------- Metric Decrease: MultiLayerModulesDefsGhcWithCore Metric Increase: MultiComponentModules MultiLayerModules T10421 T12150 T12234 T12425 T13035 T13253-spj T13701 T13719 T14697 T15703 T16875 T18698b T18140 T18304 T18698a T18730 T18923 T20049 T24582 T5837 T6048 T9198 T9961 mhu-perf ------------------------- These metric increases may look bad, but they are all completely benign, we simply allocate 1 MB per module for `shareIface`. As this allocation is quite quick, it has a negligible impact on run-time performance. In fact, the performance difference wasn't measurable on my local machine. Reducing the size of the pre-allocated 1 MB buffer avoids these test failures, but also requires us to reallocate the buffer if the interface file is too big. These reallocations *did* have an impact on performance, which is why I have opted to accept all these metric increases, as the number of allocated bytes is merely a guidance. This 1MB allocation increase causes a lot of tests to fail that generally have a low allocation number. E.g., increasing from 40MB to 41MB is a 2.5% increase. In particular, the tests T12150, T13253-spj, T18140, T18304, T18698a, T18923, T20049, T24582, T5837, T6048, and T9961 only fail on i386-darwin job, where the number of allocated bytes seems to be lower than in other jobs. The tests T16875 and T18698b fail on i386-linux for the same reason. WIP: Lazy loading of IfaceDecl - - - - - 44 changed files: - compiler/GHC.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Data/TrieMap.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.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/Fields.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Binary.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/IfaceToCore.hs-boot - compiler/GHC/Stg/CSE.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/Language/Haskell/Syntax/Type.hs-boot - docs/users_guide/using-optimisation.rst - testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs - utils/haddock The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b15caeb035b418021ab45b259a33a33… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b15caeb035b418021ab45b259a33a33… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23162-part2] Add release notes
by Simon Peyton Jones (＠simonpj) 19 Dec '25

19 Dec '25

Simon Peyton Jones pushed to branch wip/T23162-part2 at Glasgow Haskell Compiler / GHC Commits: 0432673b by Simon Peyton Jones at 2025-12-19T08:31:15+00:00 Add release notes - - - - - 1 changed file: - docs/users_guide/9.16.1-notes.rst Changes: ===================================== docs/users_guide/9.16.1-notes.rst ===================================== @@ -42,6 +42,13 @@ Compiler bound to variables. The very similar pattern ``Foo{bar = Bar{baz = 42}}`` will will not yet mark ``bar`` or ``baz`` as covered. +- GHC uses the information from the definition of a *closed* type family to + generate some extra functional dependencies for type equalities involving + that type family. As a consequence: + + * typechecking will succeed a bit more often (see :ghc-ticket:`23162`) + * pattern-match incompleteness checking is a bit smarter, giving fewer false warnings (see :ghc-ticket:`#22652`) + - When multiple ``-msse*`` flags are given, the maximum version takes effect. For example, ``-msse4.2 -msse2`` is now equivalent to ``-msse4.2``. Previously, only the last flag took effect. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0432673bdcba2c3c696f713b59c3ef9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0432673bdcba2c3c696f713b59c3ef9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] wasm: fix handling of ByteArray#/MutableByteArray# arguments in JSFFI imports
by Marge Bot (＠marge-bot) 19 Dec '25

19 Dec '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f69c5f14 by Cheng Shao at 2025-12-19T03:19:45-05:00 wasm: fix handling of ByteArray#/MutableByteArray# arguments in JSFFI imports This patch fixes the handling of ByteArray#/MutableByteArray# arguments in JSFFI imports, see the amended note and manual for explanation. Also adds a test to witness the fix. Co-authored-by: Codex <codex(a)openai.com> - - - - - 7 changed files: - compiler/GHC/HsToCore/Foreign/Wasm.hs - docs/users_guide/wasm.rst - testsuite/tests/jsffi/all.T - + testsuite/tests/jsffi/bytearrayarg.hs - + testsuite/tests/jsffi/bytearrayarg.mjs - + testsuite/tests/jsffi/bytearrayarg.stdout - testsuite/tests/perf/should_run/all.T Changes: ===================================== compiler/GHC/HsToCore/Foreign/Wasm.hs ===================================== @@ -224,6 +224,25 @@ especially since leaving all the boxing/unboxing business to C unifies the implementation of JSFFI imports and exports (rts_mkJSVal/rts_getJSVal). +We don't support unboxed FFI types like Int# etc. But we do support +one kind of unlifted FFI type for JSFFI import arguments: +ByteArray#/MutableByteArray#. The semantics is the same in C: the +pointer to the ByteArray# payload is passed instead of the ByteArray# +closure itself. This allows efficient zero-copy data exchange between +Haskell and JavaScript using unpinned ByteArray#, and the following +conditions must be met: + +- The JSFFI import itself must be a sync import marked as unsafe +- The JavaScript code must not re-enter Haskell when a ByteArray# is + passed as argument + +There's no magic in the handling of ByteArray#/MutableByteArray# +arguments. When generating C stub, we treat them like Ptr that points +to the payload, just without the rts_getPtr() unboxing call. After +lowering to C import, the backend takes care of adding the offset, see +add_shim in GHC.StgToCmm.Foreign and +Note [Unlifted boxed arguments to foreign calls]. + Now, each sync import calls a generated C function with a unique symbol. The C function uses rts_get* to unbox the arguments, call into JavaScript, then boxes the result with rts_mk* and returns it to @@ -517,8 +536,9 @@ importCStub sync cfun_name arg_tys res_ty js_src = CStub c_doc [] [] cfun_ret | res_ty `eqType` unitTy = cfun_call_import <> semi | otherwise = text "return" <+> cfun_call_import <> semi - cfun_make_arg arg_ty arg_val = - text ("rts_get" ++ ffiType arg_ty) <> parens arg_val + cfun_make_arg arg_ty arg_val + | isByteArrayPrimTy arg_ty = arg_val + | otherwise = text ("rts_get" ++ ffiType arg_ty) <> parens arg_val cfun_make_ret ret_val | res_ty `eqType` unitTy = ret_val | otherwise = @@ -543,7 +563,11 @@ importCStub sync cfun_name arg_tys res_ty js_src = CStub c_doc [] [] | res_ty `eqType` unitTy = text "void" | otherwise = text "HaskellObj" cfun_arg_list = - [text "HaskellObj" <+> char 'a' <> int n | n <- [1 .. length arg_tys]] + [ text (if isByteArrayPrimTy arg_ty then "HsPtr" else "HaskellObj") + <+> char 'a' + <> int n + | (arg_ty, n) <- zip arg_tys [1 ..] + ] cfun_args = case cfun_arg_list of [] -> text "void" _ -> hsep $ punctuate comma cfun_arg_list @@ -746,8 +770,18 @@ lookupGhcInternalTyCon m t = do n <- lookupOrig (mkGhcInternalModule m) (mkTcOcc t) dsLookupTyCon n +isByteArrayPrimTy :: Type -> Bool +isByteArrayPrimTy ty + | Just tc <- tyConAppTyCon_maybe ty, + tc == byteArrayPrimTyCon || tc == mutableByteArrayPrimTyCon = + True + | otherwise = + False + ffiType :: Type -> String -ffiType = occNameString . getOccName . fst . splitTyConApp +ffiType ty + | isByteArrayPrimTy ty = "Ptr" + | otherwise = occNameString $ getOccName $ tyConAppTyCon ty commonCDecls :: SDoc commonCDecls = ===================================== docs/users_guide/wasm.rst ===================================== @@ -265,7 +265,7 @@ backend’s JavaScript FFI, which we’ll now abbreviate as JSFFI. Marshalable types and ``JSVal`` ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -JSFFI supports all boxed marshalable foreign types in C FFI: +JSFFI supports all lifted marshalable foreign types in C FFI: - ``Bool`` - ``Char`` @@ -298,8 +298,14 @@ types in JSFFI. Some caveats to keep in mind: results in type errors, so keep this in mind. As for ``Int`` / ``Word``, they are 32-bit since the GHC wasm backend is based on ``wasm32`` . -- JSFFI doesn’t support unboxed foreign types like ``Int#``, - ``ByteArray#``, etc, even when ``UnliftedFFITypes`` is enabled. +- JSFFI doesn’t support unboxed foreign types like ``Int#``, even + when ``UnliftedFFITypes`` is enabled. The only supported unlifted + types are ``ByteArray#`` and ``MutableByteArray#``, they may only + be used as JSFFI import argument types, with the same semantics in + C FFI: the pointer to the payload is passed to JavaScript. Be + careful and avoid calling back into Haskell in such cases, + otherwise GC may occur and the pointer may be invalidated if it's + unpinned! In addition to the above types, JSFFI supports the ``JSVal`` type and its ``newtype``\ s as argument/result types. ``JSVal`` is defined in ===================================== testsuite/tests/jsffi/all.T ===================================== @@ -25,4 +25,6 @@ test('jsffion', [], compile_and_run, ['-optl-Wl,--export=main']) test('jsffisleep', [], compile_and_run, ['-optl-Wl,--export=testWouldBlock,--export=testLazySleep,--export=testThreadDelay,--export=testInterruptingSleep']) +test('bytearrayarg', [], compile_and_run, ['-optl-Wl,--export=main']) + test('textconv', [], compile_and_run, ['-optl-Wl,--export=main']) ===================================== testsuite/tests/jsffi/bytearrayarg.hs ===================================== @@ -0,0 +1,39 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Test where + +import GHC.Exts +import GHC.IO +import GHC.Word (Word8(W8#)) + +foreign import javascript unsafe "(() => { const u8 = new Uint8Array(__exports.memory.buffer, $1, 4); return (u8[0] === 0x12 && u8[1] === 0x34 && u8[2] === 0x56 && u8[3] === 0x78) ? 1 : 0; })()" + js_check_mba :: MutableByteArray# RealWorld -> IO Int + +foreign import javascript unsafe "(() => { const u8 = new Uint8Array(__exports.memory.buffer, $1, 4); return (u8[0] === 0x12 && u8[1] === 0x34 && u8[2] === 0x56 && u8[3] === 0x78) ? 1 : 0; })()" + js_check_ba :: ByteArray# -> IO Int + +foreign export javascript "main" + main :: IO () + +main :: IO () +main = + IO $ \s0 -> + case newPinnedByteArray# 4# s0 of + (# s1, mba# #) -> + case (0x12 :: Word8) of { W8# b0# -> + case (0x34 :: Word8) of { W8# b1# -> + case (0x56 :: Word8) of { W8# b2# -> + case (0x78 :: Word8) of { W8# b3# -> + let s2 = writeWord8Array# mba# 0# b0# s1 + s3 = writeWord8Array# mba# 1# b1# s2 + s4 = writeWord8Array# mba# 2# b2# s3 + s5 = writeWord8Array# mba# 3# b3# s4 + in case unIO (js_check_mba mba#) s5 of + (# s6, ok_mba #) -> case unsafeFreezeByteArray# mba# s6 of + (# s7, ba# #) -> case unIO (js_check_ba ba#) s7 of + (# s8, ok_ba #) -> case unIO (print ok_mba) s8 of + (# s9, _ #) -> case unIO (print ok_ba) s9 of + (# s10, _ #) -> (# s10, () #) + }}}} ===================================== testsuite/tests/jsffi/bytearrayarg.mjs ===================================== @@ -0,0 +1,4 @@ +export default async (__exports) => { + await __exports.main(); + process.exit(); +} ===================================== testsuite/tests/jsffi/bytearrayarg.stdout ===================================== @@ -0,0 +1,2 @@ +1 +1 ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -420,6 +420,7 @@ test('T17949', [collect_stats('bytes allocated', 1), only_ways(['normal'])], com test('ByteCodeAsm', [ extra_run_opts('"' + config.libdir + '"') , js_broken(22261) + , when(arch('wasm32'), run_timeout_multiplier(10)) , collect_stats('bytes allocated', 10), ], compile_and_run, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f69c5f1492b275da7d2947612574d5c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f69c5f1492b275da7d2947612574d5c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Remove unused known keys and names for generics classes
by Marge Bot (＠marge-bot) 19 Dec '25

19 Dec '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 73ee7e38 by Wolfgang Jeltsch at 2025-12-19T03:19:02-05:00 Remove unused known keys and names for generics classes This removes the known-key and corresponding name variables for `Datatype`, `Constructor`, and `Selector` from `GHC.Generics`, as they are apparently nowhere used in GHC’s source code. - - - - - 1 changed file: - compiler/GHC/Builtin/Names.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -476,7 +476,6 @@ basicKnownKeyNames -- Generics , genClassName, gen1ClassName - , datatypeClassName, constructorClassName, selectorClassName -- Monad comprehensions , guardMName @@ -1480,15 +1479,10 @@ readClassName :: Name readClassName = clsQual gHC_INTERNAL_READ (fsLit "Read") readClassKey -- Classes Generic and Generic1, Datatype, Constructor and Selector -genClassName, gen1ClassName, datatypeClassName, constructorClassName, - selectorClassName :: Name +genClassName, gen1ClassName :: Name genClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Generic") genClassKey gen1ClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Generic1") gen1ClassKey -datatypeClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Datatype") datatypeClassKey -constructorClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Constructor") constructorClassKey -selectorClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Selector") selectorClassKey - genericClassNames :: [Name] genericClassNames = [genClassName, gen1ClassName] @@ -1739,15 +1733,10 @@ applicativeClassKey = mkPreludeClassUnique 34 foldableClassKey = mkPreludeClassUnique 35 traversableClassKey = mkPreludeClassUnique 36 -genClassKey, gen1ClassKey, datatypeClassKey, constructorClassKey, - selectorClassKey :: Unique +genClassKey, gen1ClassKey :: Unique genClassKey = mkPreludeClassUnique 37 gen1ClassKey = mkPreludeClassUnique 38 -datatypeClassKey = mkPreludeClassUnique 39 -constructorClassKey = mkPreludeClassUnique 40 -selectorClassKey = mkPreludeClassUnique 41 - -- KnownNat: see Note [KnownNat & KnownSymbol and EvLit] in GHC.Tc.Instance.Class knownNatClassNameKey :: Unique knownNatClassNameKey = mkPreludeClassUnique 42 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73ee7e38f5792c3bb9d5d61d9621d54… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73ee7e38f5792c3bb9d5d61d9621d54… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Remove unused known-key and name variables for generics
by Marge Bot (＠marge-bot) 19 Dec '25

19 Dec '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 91edd292 by Wolfgang Jeltsch at 2025-12-19T03:18:19-05:00 Remove unused known-key and name variables for generics This removes the known-key and corresponding name variables for `K1`, `M1`, `R`, `D`, `C`, `S`, and `URec` from `GHC.Generics`, as they are apparently nowhere used in GHC’s source code. - - - - - 1 changed file: - compiler/GHC/Builtin/Names.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -517,12 +517,9 @@ basicKnownKeyNames genericTyConNames :: [Name] genericTyConNames = [ - v1TyConName, u1TyConName, par1TyConName, rec1TyConName, - k1TyConName, m1TyConName, sumTyConName, prodTyConName, - compTyConName, rTyConName, dTyConName, - cTyConName, sTyConName, rec0TyConName, - d1TyConName, c1TyConName, s1TyConName, - repTyConName, rep1TyConName, uRecTyConName, + v1TyConName, u1TyConName, par1TyConName, rec1TyConName, sumTyConName, + prodTyConName, compTyConName, rec0TyConName, d1TyConName, c1TyConName, + s1TyConName, repTyConName, rep1TyConName, uAddrTyConName, uCharTyConName, uDoubleTyConName, uFloatTyConName, uIntTyConName, uWordTyConName, prefixIDataConName, infixIDataConName, leftAssociativeDataConName, @@ -939,11 +936,8 @@ voidTyConName = tcQual gHC_INTERNAL_BASE (fsLit "Void") voidTyConKey -- Generics (types) v1TyConName, u1TyConName, par1TyConName, rec1TyConName, - k1TyConName, m1TyConName, sumTyConName, prodTyConName, - compTyConName, rTyConName, dTyConName, - cTyConName, sTyConName, rec0TyConName, - d1TyConName, c1TyConName, s1TyConName, - repTyConName, rep1TyConName, uRecTyConName, + sumTyConName, prodTyConName, compTyConName, rec0TyConName, d1TyConName, + c1TyConName, s1TyConName, repTyConName, rep1TyConName, uAddrTyConName, uCharTyConName, uDoubleTyConName, uFloatTyConName, uIntTyConName, uWordTyConName, prefixIDataConName, infixIDataConName, leftAssociativeDataConName, @@ -958,18 +952,11 @@ v1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "V1") v1TyConKey u1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "U1") u1TyConKey par1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Par1") par1TyConKey rec1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rec1") rec1TyConKey -k1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "K1") k1TyConKey -m1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "M1") m1TyConKey sumTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit ":+:") sumTyConKey prodTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit ":*:") prodTyConKey compTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit ":.:") compTyConKey -rTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "R") rTyConKey -dTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "D") dTyConKey -cTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "C") cTyConKey -sTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "S") sTyConKey - rec0TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rec0") rec0TyConKey d1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "D1") d1TyConKey c1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "C1") c1TyConKey @@ -978,7 +965,6 @@ s1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "S1") s1TyConKey repTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rep") repTyConKey rep1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rep1") rep1TyConKey -uRecTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "URec") uRecTyConKey uAddrTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "UAddr") uAddrTyConKey uCharTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "UChar") uCharTyConKey uDoubleTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "UDouble") uDoubleTyConKey @@ -1950,11 +1936,8 @@ typeLitSortTyConKey = mkPreludeTyConUnique 108 -- Generics (Unique keys) v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey, - k1TyConKey, m1TyConKey, sumTyConKey, prodTyConKey, - compTyConKey, rTyConKey, dTyConKey, - cTyConKey, sTyConKey, rec0TyConKey, - d1TyConKey, c1TyConKey, s1TyConKey, - repTyConKey, rep1TyConKey, uRecTyConKey, + sumTyConKey, prodTyConKey, compTyConKey, rec0TyConKey, + d1TyConKey, c1TyConKey, s1TyConKey, repTyConKey, rep1TyConKey, uAddrTyConKey, uCharTyConKey, uDoubleTyConKey, uFloatTyConKey, uIntTyConKey, uWordTyConKey :: Unique @@ -1962,18 +1945,11 @@ v1TyConKey = mkPreludeTyConUnique 135 u1TyConKey = mkPreludeTyConUnique 136 par1TyConKey = mkPreludeTyConUnique 137 rec1TyConKey = mkPreludeTyConUnique 138 -k1TyConKey = mkPreludeTyConUnique 139 -m1TyConKey = mkPreludeTyConUnique 140 sumTyConKey = mkPreludeTyConUnique 141 prodTyConKey = mkPreludeTyConUnique 142 compTyConKey = mkPreludeTyConUnique 143 -rTyConKey = mkPreludeTyConUnique 144 -dTyConKey = mkPreludeTyConUnique 146 -cTyConKey = mkPreludeTyConUnique 147 -sTyConKey = mkPreludeTyConUnique 148 - rec0TyConKey = mkPreludeTyConUnique 149 d1TyConKey = mkPreludeTyConUnique 151 c1TyConKey = mkPreludeTyConUnique 152 @@ -1982,7 +1958,6 @@ s1TyConKey = mkPreludeTyConUnique 153 repTyConKey = mkPreludeTyConUnique 155 rep1TyConKey = mkPreludeTyConUnique 156 -uRecTyConKey = mkPreludeTyConUnique 157 uAddrTyConKey = mkPreludeTyConUnique 158 uCharTyConKey = mkPreludeTyConUnique 159 uDoubleTyConKey = mkPreludeTyConUnique 160 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91edd2921665f935d1dba466ec4d5dc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91edd2921665f935d1dba466ec4d5dc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23162-part2] Wibble unused variables
by Simon Peyton Jones (＠simonpj) 19 Dec '25

19 Dec '25

Simon Peyton Jones pushed to branch wip/T23162-part2 at Glasgow Haskell Compiler / GHC Commits: 435c7237 by Simon Peyton Jones at 2025-12-19T08:16:59+00:00 Wibble unused variables - - - - - 1 changed file: - compiler/GHC/Tc/Errors/Ppr.hs Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -4202,7 +4202,7 @@ pprTcSolverReportMsg _ (AmbiguityPreventsSolvingCt item ambigs) = pprArising (errorItemCtLoc item) $$ text "prevents the constraint" <+> quotes (pprParendType $ errorItemPred item) <+> text "from being solved." -pprTcSolverReportMsg ctxt@(CEC {cec_encl = implics}) +pprTcSolverReportMsg ctxt (CannotResolveInstance item unifiers candidates rel_binds mb_HasField_msg) = pprWithInvisibleBits invis_bits $ vcat @@ -4370,7 +4370,6 @@ pprTcSolverReportMsg ctxt (OverlappingInstances item matches unifiers) = ])] where ct_loc = errorItemCtLoc item - orig = ctLocOrigin ct_loc pred = errorItemPred item (clas, tys) = getClassPredTys pred tyCoVars = tyCoVarsOfTypesList tys View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/435c72375862a317cf386a52d643f4d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/435c72375862a317cf386a52d643f4d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][ghc-9.14] 3 commits: docs: note #26543 in known bugs
by Zubin (＠wz1000) 19 Dec '25

19 Dec '25

Zubin pushed to branch ghc-9.14 at Glasgow Haskell Compiler / GHC Commits: ebc6d49b by Zubin Duggal at 2025-12-17T20:07:36+05:30 docs: note #26543 in known bugs - - - - - 9589591f by Zubin Duggal at 2025-12-18T02:13:34+05:30 rel-notes: updates for final 9.14.1 release - - - - - 902339d3 by Zubin Duggal at 2025-12-18T11:00:51+05:30 Prepare final 9.14.1 release - - - - - 4 changed files: - configure.ac - docs/users_guide/9.14.1-notes.rst - docs/users_guide/bugs.rst - libraries/base/changelog.md Changes: ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.14.0], [glasgow-haskell-bugs(a)haskell.org] [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.14.1], [glasgow-haskell-bugs(a)haskell.org] [ghc-AC_PACKAGE_VERSION]) # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058). However, the version must have three components # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are @@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.14.0], [glasgow-ha AC_CONFIG_MACRO_DIRS([m4]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=NO} +: ${RELEASE=YES} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the ===================================== docs/users_guide/9.14.1-notes.rst ===================================== @@ -110,6 +110,9 @@ Language - Explicit level import support, allowing ``import`` declarations to explicitly state which compilation stages they are are visible to. +- Fix handling of tabs in string gaps (:ghc-ticket:`26415`). Tabs are now + correctly treated as whitespace in string gaps, matching the Haskell Report. + Compiler ~~~~~~~~ @@ -160,6 +163,23 @@ Compiler - Initial native code generator support for the LoongArch CPU architecture. +- Several fixes to :extension:`DeepSubsumption` type checking, improving handling + of higher-rank types in various contexts (:ghc-ticket:`26225`, :ghc-ticket:`26255`, + :ghc-ticket:`26277`, :ghc-ticket:`26331`, :ghc-ticket:`26332`). + +- Fix a scoping error in the Specialiser that could cause incorrect code generation + with :ghc-flag:`-fpolymorphic-specialisation` (:ghc-ticket:`26329`). + +- Fix a long-standing bug in the coercion optimiser that could produce invalid + coercions for ``ForAllCo`` (:ghc-ticket:`26345`). + +- Fix the type-family occurs check in unification (:ghc-ticket:`26457`). + +- Fix solving of forall-constraints (quantified constraints) to avoid infinite + loops in certain cases (:ghc-ticket:`26314`, :ghc-ticket:`26315`, :ghc-ticket:`26376`). + +- Fix reporting of redundant constraints on default-method declarations + (:ghc-ticket:`25992`). GHCi ~~~~ @@ -188,6 +208,12 @@ GHCi debugging clients * Internal refactorings towards making the debugger multi-thread aware (:ghc-ticket:`26064`) +- Fix bytecode generation for unsaturated applications of data constructor + workers (:ghc-ticket:`23210`). + +- Fix bytecode to use 32 bits for breakpoint indices, allowing more breakpoints + in large modules (:ghc-ticket:`26325`). + WebAssembly backend ~~~~~~~~~~~~~~~~~~~ @@ -201,6 +227,18 @@ See the blog post on `Tweag's blog <https://www.tweag.io/blog/2025-04-17-wasm-ghci-browser/>`_ for more information. +- Fix handling of forward declared ``GOT.func`` items in the wasm dynamic + linker (:ghc-ticket:`26430`). + +- Fix ``setKeepCAFs()`` to be properly called during wasm GHCi initialization + (:ghc-ticket:`26106`). + +- Fix JSFFI initialization constructor code to avoid clashing with user-defined + main functions. + +- Improve error handling in the JavaScript linker when library directories + are misconfigured (:ghc-ticket:`26383`). + Runtime system ~~~~~~~~~~~~~~ @@ -212,17 +250,44 @@ Runtime system - Reorganise how certain symbols are linked to avoid a bootstrapping failure with the linker shipping newer macOS versions (:ghc-ticket:`26166`) +- Fix eager black holes handling: properly record mutated closures and fix + an incorrect assertion that could cause issues with multiple threads racing + to claim a black hole (:ghc-ticket:`26495`) + +- Fix the Windows runtime linker to copy DLL path strings before inserting + them into the cache, preventing use-after-free issues (:ghc-ticket:`26613`) + +- Fix lost wakeups in ``threadPaused`` for threads blocked on black holes, + which could cause hangs in concurrent programs (:ghc-ticket:`26324`). + +- Fix heap reservation logic on POSIX systems to avoid infinite loops when + the OS repeatedly returns low memory addresses (:ghc-ticket:`26151`). + +- Fix handling of ``WHITEHOLE`` closures in ``scavenge_one`` when using the + non-moving garbage collector (:ghc-ticket:`26204`). + +- Fix alignment for ``gen_workspace`` on s390x to allow bootstrap on that + platform (:ghc-ticket:`26334`). + +- Push the correct update frame type in ``stg_AP_STACK`` for eager black holes. + ``base`` library ~~~~~~~~~~~~~~~~ - Updated to `Unicode 17.0.0 <https://www.unicode.org/versions/Unicode17.0.0>`_. +- Removed unstable heap representation details from ``GHC.Exts`` (:ghc-ticket:`25110`). + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ``ghc-prim`` is now a legacy interface providing access to primitive operations and types which are now also exposed via the ``ghc-experimental`` package. +- A new primop ``annotateStack#`` has been added, allowing arbitrary data to be + pushed onto the call stack for later extraction when decoding stack traces + (:ghc-ticket:`26218`). + ``ghc`` library ~~~~~~~~~~~~~~~ @@ -263,6 +328,16 @@ and types which are now also exposed via the ``ghc-experimental`` package. reading of the relevant Closure attributes without reliance on incomplete selectors. +* Fix a race condition with profiling builds (:ghc-ticket:`15197`, :ghc-ticket:`26407`). + +* Fix stack decoding when using the profiled runtime (:ghc-ticket:`26507`). + +``ghc-internal`` library +~~~~~~~~~~~~~~~~~~~~~~~~ + +* Fix ``naturalAndNot`` for the ``NB``/``NS`` (native bignum) case + (:ghc-ticket:`26230`). + ``ghc-experimental`` library ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/bugs.rst ===================================== @@ -701,6 +701,9 @@ Bugs in GHC - Because of a toolchain limitation we are unable to support full Unicode paths on Windows. On Windows we support up to Latin-1. See :ghc-ticket:`12971` for more. +- The typechecker might reject certain programs using the ``($)`` operator which + are accepted by using explicit parentheses. See :ghc-ticket:`26543` for details. + .. _bugs-ghci: Bugs in GHCi (the interactive GHC) ===================================== libraries/base/changelog.md ===================================== @@ -1,6 +1,6 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) -## 4.22.0.0 *TBA* +## 4.22.0.0 *December 2025* * Shipped with GHC 9.14.1 * The internal `GHC.Weak.Finalize.runFinalizerBatch` function has been deprecated ([CLC proposal #342](https://github.com/haskell/core-libraries-committee/issues/342)) * Define `displayException` of `SomeAsyncException` to unwrap the exception. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/85e8147dd7893db46db1868d65f4cf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/85e8147dd7893db46db1868d65f4cf… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26670] 2 commits: Cleaning up trailing whitespace
by recursion-ninja (＠recursion-ninja) 19 Dec '25

19 Dec '25

recursion-ninja pushed to branch wip/fix-26670 at Glasgow Haskell Compiler / GHC Commits: 2d3d798a by Recursion Ninja at 2025-12-18T20:59:28-05:00 Cleaning up trailing whitespace - - - - - 67723c02 by Recursion Ninja at 2025-12-18T21:23:24-05:00 Improving code clarity with more decriptive 'InlineArity' constructor names and better comments throughout. - - - - - 10 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/InlinePragma.hs - compiler/GHC/Utils/Binary.hs - libraries/exceptions Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -657,30 +657,30 @@ tryCastWorkerWrapper env _ _ bndr rhs -- All other bindings mkCastWrapperInlinePrag :: InlinePragma GhcRn -> InlinePragma GhcRn -- See Note [Cast worker/wrapper] -mkCastWrapperInlinePrag prag = - -- Consider each field of the 'InlinePragma' constructor - -- and deterimine what is the appropriate definition for the - -- corresponding value used within a worker/wrapper. - -- - -- 1. 'inl_ext': Overwrite - setInlinePragmaArityAsNotExplicit prag - `setInlinePragmaSource` src_txt - -- - -- 2. 'inl_inline': *Preserve* - -- See Note [Worker/wrapper for INLINABLE functions] - -- in GHC.Core.Opt.WorkWrap - -- <SKIP> - -- - -- 3. 'inl_act': Conditionally Update - -- See Note [Wrapper activation] - -- in GHC.Core.Opt.WorkWrap - `setInlinePragmaActivation` wrap_act - -- - -- 4. 'inl_rule': *Preserve* - -- RuleMatchInfo is (and must be) unaffected - -- <SKIP> - -- - -- <DONE> +mkCastWrapperInlinePrag prag = prag + -- Consider each field of the 'InlinePragma' constructor + -- and deterimine what is the appropriate definition for the + -- corresponding value used within a worker/wrapper. + -- + -- 1. 'inl_ext': Overwrite with defaults + -- > Changes <SOME> + `setInlinePragmaSource` src_txt + `setInlinePragmaArity` AnyArity + -- + -- 2. 'inl_inline': *Preserve* + -- See Note [Worker/wrapper for INLINABLE functions] + -- in GHC.Core.Opt.WorkWrap + -- > Changes <NONE> + -- + -- 3. 'inl_act': Conditionally Update + -- See Note [Wrapper activation] + -- in GHC.Core.Opt.WorkWrap + -- > Changes <SOME> + `setInlinePragmaActivation` wrap_act + -- + -- 4. 'inl_rule': *Preserve* + -- RuleMatchInfo is (and must be) unaffected + -- > Changes <NONE> where -- See Note [Wrapper activation] in GHC.Core.Opt.WorkWrap -- But simpler, because we don't need to disable during InitialPhase ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -834,7 +834,7 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div _ -> inl_act wrap_prag srcTxt = SourceText $ fsLit "{-# INLINE" - work_prag = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt ArityNotExplicit + work_prag = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt AnyArity , inl_inline = fn_inline_spec , inl_act = work_act , inl_rule = FunLike } @@ -901,7 +901,7 @@ mkStrWrapperInlinePrag :: InlinePragma (GhcPass p) -> [CoreRule] -> InlinePragma mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl , inl_act = fn_act , inl_rule = rule_info }) rules - = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt ArityNotExplicit + = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt AnyArity , inl_inline = fn_inl -- See Note [Worker/wrapper for INLINABLE functions] ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -456,7 +456,7 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs inline_prag = idInlinePragma gbl_id inlinable_unf = mkInlinableUnfolding simpl_opts StableUserSrc rhs inline_pair - | ArityExplicitly arity <- inlinePragmaArity inline_prag + | AppliedToAtLeast arity <- inlinePragmaArity inline_prag -- Add an Unfolding for an INLINE (but not for NOINLINE) -- And eta-expand the RHS; see Note [Eta-expanding INLINE things] , let real_arity = dict_arity + fromEnum arity ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -1103,7 +1103,7 @@ renameSig ctxt sig@(SpecSig _ v tys inl) TopSigCtxt {} -> lookupLocatedOccRn WL_TermVariable v _ -> lookupSigOccRn ctxt sig v ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys - ; return (SpecSig noAnn new_v new_ty (setInlinePragmaArityAsNotExplicit inl), fvs) } + ; return (SpecSig noAnn new_v new_ty (inl `setInlinePragmaArity` AnyArity), fvs) } where do_one (tys,fvs) ty = do { (new_ty, fvs_ty) <- rnHsSigType (SpecialiseSigCtx v) TypeLevel ty @@ -1114,11 +1114,11 @@ renameSig _ctxt (SpecSigE _ bndrs spec_e inl) ; fn_name <- lookupOccRn WL_TermVariable fn_rdr -- Checks that the head isn't forall-bound ; bindRuleBndrs (SpecECtx fn_rdr) bndrs $ \_ bndrs' -> do { (spec_e', fvs) <- rnLExpr spec_e - ; return (SpecSigE fn_name bndrs' spec_e' (setInlinePragmaArityAsNotExplicit inl), fvs) } } + ; return (SpecSigE fn_name bndrs' spec_e' (inl `setInlinePragmaArity` AnyArity), fvs) } } renameSig ctxt sig@(InlineSig _ v s) = do { new_v <- lookupSigOccRn ctxt sig v - ; return (InlineSig noAnn new_v (setInlinePragmaArityAsNotExplicit s), emptyFVs) } + ; return (InlineSig noAnn new_v (s `setInlinePragmaArity` AnyArity), emptyFVs) } renameSig ctxt (FixSig _ fsig) = do { new_fsig <- rnSrcFixityDecl ctxt fsig ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -604,7 +604,7 @@ addInlinePragArity _ sig = sig add_inl_arity :: Arity -> InlinePragma GhcRn -> InlinePragma GhcRn add_inl_arity ar prag@(InlinePragma { inl_inline = inl_spec }) | Inline {} <- inl_spec -- Add arity only for real INLINE pragmas, not INLINABLE - = prag `setInlinePragmaArityAsExplicitly` ar + = prag `setInlinePragmaArity` AppliedToAtLeast ar | otherwise = prag ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -2265,7 +2265,7 @@ mkDefMethBind loc dfun_id clas sel_id dm_name dm_spec = do { logger <- getLogger ; dm_id <- tcLookupId dm_name ; let inline_prag :: InlinePragma GhcRn - inline_prag = idInlinePragma dm_id + inline_prag = idInlinePragma dm_id inline_prags | isAnyInlinePragma inline_prag = [noLocA (InlineSig noAnn fn inline_prag)] | otherwise ===================================== compiler/GHC/Types/Arity.hs ===================================== @@ -41,21 +41,21 @@ type FullArgCount = Int -- | The arity /at which to/ inline a function. -- This may differ from the function's syntactic arity. data InlineArity - = ArityExplicitly !Word + = AppliedToAtLeast !Arity -- ^ Inline only when applied to @n@ explicit -- (non-type, non-dictionary) arguments. - -- - -- That is, 'ArityExplicitly' describes the number of + -- + -- That is, 'AppliedToAtLeast' describes the number of -- *source-code* arguments the thing must be applied to. - | ArityNotExplicit + | AnyArity -- ^ There does not exist an explicit number of arguments -- that the inlining process should be applied to. deriving (Eq, Data) instance NFData InlineArity where - rnf (ArityExplicitly !w) = rnf w `seq` () - rnf !ArityNotExplicit = () + rnf (AppliedToAtLeast !w) = rnf w `seq` () + rnf !AnyArity = () -- | Representation Arity -- ===================================== compiler/GHC/Types/InlinePragma.hs ===================================== @@ -35,8 +35,7 @@ module GHC.Types.InlinePragma , isOpaquePragma -- *** Mutators , setInlinePragmaSource - , setInlinePragmaArityAsExplicitly - , setInlinePragmaArityAsNotExplicit + , setInlinePragmaArity , setInlinePragmaActivation , setInlinePragmaSpec , setInlinePragmaRuleMatchInfo @@ -111,7 +110,7 @@ import Language.Haskell.Syntax.Extension -- infixl so you can say (prag `set` a `set` b) infixl 1 `setInlinePragmaActivation`, - `setInlinePragmaArityAsExplicitly`, + `setInlinePragmaArity`, `setInlinePragmaRuleMatchInfo`, `setInlinePragmaSource`, `setInlinePragmaSpec` @@ -149,8 +148,8 @@ defaultInlinePragma = let srcTxt = SourceText $ fsLit "{-# INLINE" inlExt = case ghcPass @p of GhcPs -> srcTxt - GhcRn -> XInlinePragmaGhc srcTxt ArityNotExplicit - GhcTc -> XInlinePragmaGhc srcTxt ArityNotExplicit + GhcRn -> XInlinePragmaGhc srcTxt AnyArity + GhcTc -> XInlinePragmaGhc srcTxt AnyArity in InlinePragma { inl_ext = inlExt , inl_act = AlwaysActive @@ -185,16 +184,6 @@ setInlinePragmaArity :: forall p q. (IsPass p, XInlinePragma (GhcPass q) ~ XInli setInlinePragmaArity prag arity = prag { inl_ext = XInlinePragmaGhc (inlinePragmaSource prag) arity } -setInlinePragmaArityAsExplicitly :: forall a p q. (Integral a, IsPass p, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc) - => InlinePragma (GhcPass p) -> a -> InlinePragma (GhcPass q) -setInlinePragmaArityAsExplicitly prag intVal = prag `setInlinePragmaArity` arity - where - arity = ArityExplicitly . fromIntegral $ abs intVal - -setInlinePragmaArityAsNotExplicit :: forall p q. (IsPass p, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc) - => InlinePragma (GhcPass p) -> InlinePragma (GhcPass q) -setInlinePragmaArityAsNotExplicit = flip setInlinePragmaArity ArityNotExplicit - inlinePragmaSource :: forall p. IsPass p => InlinePragma (GhcPass p) -> SourceText inlinePragmaSource (InlinePragma { inl_ext = src }) = srcTxt where ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -2108,10 +2108,10 @@ instance Binary RuleMatchInfo where else pure FunLike instance Binary InlineArity where - put_ bh ArityNotExplicit = putByte bh 0 - put_ bh (ArityExplicitly w) = putByte bh 1 *> put_ bh w + put_ bh AnyArity = putByte bh 0 + put_ bh (AppliedToAtLeast w) = putByte bh 1 *> put_ bh w get bh = do h <- getByte bh - if h == 0 then pure ArityNotExplicit - else ArityExplicitly <$> get bh + if h == 0 then pure AnyArity + else AppliedToAtLeast <$> get bh ===================================== libraries/exceptions ===================================== @@ -1 +1 @@ -Subproject commit 81bfd6e0ca631f315658201ae02e30046678f056 +Subproject commit b6c4290124eb1138358bf04ad9f33e67f6c5c1d8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7d47d203034f014791a2aa2cfb8fd… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7d47d203034f014791a2aa2cfb8fd… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26670] Reverting semantic changes where Arity was erroneously set to 0
by recursion-ninja (＠recursion-ninja) 18 Dec '25

18 Dec '25

recursion-ninja pushed to branch wip/fix-26670 at Glasgow Haskell Compiler / GHC Commits: f7d47d20 by Recursion Ninja at 2025-12-18T18:52:11-05:00 Reverting semantic changes where Arity was erroneously set to 0 - - - - - 17 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/InlinePragma.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -655,27 +655,39 @@ tryCastWorkerWrapper env _ _ bndr rhs -- All other bindings , text "rhs:" <+> ppr rhs ]) ; return (mkFloatBind env (NonRec bndr rhs)) } -mkCastWrapperInlinePrag :: forall p. IsPass p => InlinePragma (GhcPass p) -> InlinePragma (GhcPass p) +mkCastWrapperInlinePrag :: InlinePragma GhcRn -> InlinePragma GhcRn -- See Note [Cast worker/wrapper] -mkCastWrapperInlinePrag (InlinePragma { inl_ext = inTag, inl_inline = fn_inl, inl_act = fn_act, inl_rule = rule_info }) - = InlinePragma { inl_ext = outTag - , inl_inline = fn_inl -- See Note [Worker/wrapper for INLINABLE functions] - , inl_act = wrap_act -- See Note [Wrapper activation] - , inl_rule = rule_info } -- in GHC.Core.Opt.WorkWrap - -- RuleMatchInfo is (and must be) unaffected +mkCastWrapperInlinePrag prag = + -- Consider each field of the 'InlinePragma' constructor + -- and deterimine what is the appropriate definition for the + -- corresponding value used within a worker/wrapper. + -- + -- 1. 'inl_ext': Overwrite + setInlinePragmaArityAsNotExplicit prag + `setInlinePragmaSource` src_txt + -- + -- 2. 'inl_inline': *Preserve* + -- See Note [Worker/wrapper for INLINABLE functions] + -- in GHC.Core.Opt.WorkWrap + -- <SKIP> + -- + -- 3. 'inl_act': Conditionally Update + -- See Note [Wrapper activation] + -- in GHC.Core.Opt.WorkWrap + `setInlinePragmaActivation` wrap_act + -- + -- 4. 'inl_rule': *Preserve* + -- RuleMatchInfo is (and must be) unaffected + -- <SKIP> + -- + -- <DONE> where -- See Note [Wrapper activation] in GHC.Core.Opt.WorkWrap -- But simpler, because we don't need to disable during InitialPhase wrap_act | isNeverActive fn_act = activateDuringFinal | otherwise = fn_act - - srcTxt = SourceText $ fsLit "{-# INLINE" - - outTag = case ghcPass @p of - GhcPs -> inTag - GhcRn -> inTag { inl_ghcrn_src = srcTxt } - GhcTc -> inTag { inl_ghcrn_src = srcTxt } - + fn_act = inlinePragmaActivation prag + src_txt = SourceText $ fsLit "{-# INLINE" {- ********************************************************************* * * ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -44,7 +44,7 @@ import GHC.Data.Bag import GHC.Data.OrdList import GHC.Data.List.SetOps -import GHC.Hs.Extension ( GhcTc ) +import GHC.Hs.Extension ( GhcRn ) import GHC.Types.Basic import GHC.Types.Unique.Supply @@ -1639,6 +1639,16 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs -- See Note [Account for casts in binding] + -- Copy InlinePragma information from the parent Id. + -- So if f has INLINE[1] so does spec_fn + spec_inl_prag :: InlinePragma GhcRn + spec_inl_prag + | not is_local -- See Note [Specialising imported functions] + , isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal + = neverInlinePragma + | otherwise + = inl_prag + not_in_scope :: InterestingVarFun not_in_scope v = isLocalVar v && not (v `elemInScopeSet` in_scope) @@ -1754,20 +1764,9 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs -- See Note [Arity decrease] in GHC.Core.Opt.Simplify join_arity_decr = length rule_lhs_args - length rule_rhs_args1 arity_decr = count isValArg rule_lhs_args - count isId rule_rhs_args1 - arity = max 0 (fn_arity - arity_decr) - - -- Copy InlinePragma information from the parent Id. - -- So if f has INLINE[1] so does spec_fn - spec_inl_prag :: InlinePragma GhcTc - spec_inl_prag - | not is_local -- See Note [Specialising imported functions] - , isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal - = neverInlinePragma `setInlinePragmaArity` arity - | otherwise - = inl_prag `setInlinePragmaArity` arity spec_fn_info - = vanillaIdInfo `setArityInfo` arity + = vanillaIdInfo `setArityInfo` max 0 (fn_arity - arity_decr) `setInlinePragInfo` spec_inl_prag `setUnfoldingInfo` spec_unf ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -22,7 +22,7 @@ import GHC.Core.SimpleOpt import GHC.Data.FastString -import GHC.Hs.Extension (GhcPass, GhcTc) +import GHC.Hs.Extension (GhcPass, GhcRn) import GHC.Types.Var import GHC.Types.Id @@ -834,7 +834,7 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div _ -> inl_act wrap_prag srcTxt = SourceText $ fsLit "{-# INLINE" - work_prag = InlinePragma { inl_ext = InlinePragmaGhcTag srcTxt arity + work_prag = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt ArityNotExplicit , inl_inline = fn_inline_spec , inl_act = work_act , inl_rule = FunLike } @@ -883,7 +883,7 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div | otherwise = topDmd wrap_rhs = wrap_fn work_id - wrap_prag = mkStrWrapperInlinePrag fn_inl_prag fn_rules arity + wrap_prag = mkStrWrapperInlinePrag fn_inl_prag fn_rules wrap_unf = mkWrapperUnfolding simpl_opts wrap_rhs arity wrap_id = fn_id `setIdUnfolding` wrap_unf @@ -897,11 +897,11 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div fn_unfolding = realUnfoldingInfo fn_info fn_rules = ruleInfoRules (ruleInfo fn_info) -mkStrWrapperInlinePrag :: InlinePragma (GhcPass p) -> [CoreRule] -> Arity -> InlinePragma GhcTc +mkStrWrapperInlinePrag :: InlinePragma (GhcPass p) -> [CoreRule] -> InlinePragma GhcRn mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl , inl_act = fn_act - , inl_rule = rule_info }) rules arity - = InlinePragma { inl_ext = InlinePragmaGhcTag srcTxt arity + , inl_rule = rule_info }) rules + = InlinePragma { inl_ext = XInlinePragmaGhc srcTxt ArityNotExplicit , inl_inline = fn_inl -- See Note [Worker/wrapper for INLINABLE functions] ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -503,8 +503,7 @@ toIfaceIdInfo id_info ------------ Inline prag -------------- inline_prag = inlinePragInfo id_info inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing - | otherwise = Just . HsInline $ - inline_prag `setInlinePragmaArity` arity_info + | otherwise = Just (HsInline inline_prag) -------------------------- toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -324,8 +324,7 @@ dsAbsBinds dflags tyvars dicts exports -- No SpecPrags (no dicts) -- Can't be a default method (default methods are singletons) = do { dsHsWrapper wrap $ \core_wrap -> do - { return ( gbl_id `setInlinePragma` - (defaultInlinePragma `setInlinePragmaArity` 0) + { return ( gbl_id `setInlinePragma` defaultInlinePragma , core_wrap (Var lcl_id)) } } ; main_prs <- mapM mk_main exports ; let bind_prs' = map mk_aux_bind bind_prs @@ -370,8 +369,7 @@ dsAbsBinds dflags tyvars dicts exports mkVarApps (Var poly_tup_id) (tyvars ++ dicts) rhs_for_spec = Let (NonRec poly_tup_id poly_tup_rhs) rhs ; (spec_binds, rules) <- dsSpecs rhs_for_spec spec_prags - ; let global' = (global `setInlinePragma` - (defaultInlinePragma `setInlinePragmaArity` dictArity dicts)) + ; let global' = (global `setInlinePragma` defaultInlinePragma) `addIdSpecialisations` rules -- Kill the INLINE pragma because it applies to -- the user written (local) function. The global @@ -447,7 +445,7 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding' simpl_opts rhs, rhs) | otherwise - = case inl_spec of + = case inlinePragmaSpec inline_prag of NoUserInlinePrag -> (gbl_id, rhs) NoInline {} -> (gbl_id, rhs) Opaque {} -> (gbl_id, rhs) @@ -455,16 +453,21 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs Inline {} -> inline_pair where simpl_opts = initSimpleOpts dflags - InlinePragma (InlinePragmaGhcTag _ arity) inl_spec _ _ = idInlinePragma gbl_id + inline_prag = idInlinePragma gbl_id inlinable_unf = mkInlinableUnfolding simpl_opts StableUserSrc rhs - inline_pair = - -- Add an Unfolding for an INLINE (but not for NOINLINE) - -- And eta-expand the RHS; see Note [Eta-expanding INLINE things] - let real_arity = dict_arity + arity - -- NB: The arity passed to mkInlineUnfoldingWithArity - -- must take account of the dictionaries - in ( gbl_id `setIdUnfolding` mkInlineUnfoldingWithArity simpl_opts StableUserSrc real_arity rhs - , etaExpand real_arity rhs) + inline_pair + | ArityExplicitly arity <- inlinePragmaArity inline_prag + -- Add an Unfolding for an INLINE (but not for NOINLINE) + -- And eta-expand the RHS; see Note [Eta-expanding INLINE things] + , let real_arity = dict_arity + fromEnum arity + -- NB: The arity passed to mkInlineUnfoldingWithArity + -- must take account of the dictionaries + = ( gbl_id `setIdUnfolding` mkInlineUnfoldingWithArity simpl_opts StableUserSrc real_arity rhs + , etaExpand real_arity rhs) + + | otherwise + = pprTrace "makeCorePair: arity missing" (ppr gbl_id) $ + (gbl_id `setIdUnfolding` mkInlineUnfoldingNoArity simpl_opts StableUserSrc rhs, rhs) dictArity :: [Var] -> Arity -- Don't count coercion variables in arity @@ -1017,7 +1020,7 @@ dsSpec_help poly_nm poly_id poly_rhs spec_inl orig_bndrs ds_call fn_unf = realIdUnfolding poly_id spec_unf = specUnfolding simpl_opts spec_bndrs mk_spec_body rule_lhs_args fn_unf spec_info = vanillaIdInfo - `setInlinePragInfo` specFunInlinePrag poly_id id_inl spec_inl + `setInlinePragInfo` specFunInlinePrag poly_id id_inl (demoteInlinePragmaTc spec_inl) `setUnfoldingInfo` spec_unf spec_id = mkLocalVar (idDetails poly_id) spec_name ManyTy spec_ty spec_info -- Specialised binding is toplevel, hence Many. @@ -1057,7 +1060,7 @@ dsSpec_help poly_nm poly_id poly_rhs spec_inl orig_bndrs ds_call ; dsWarnOrphanRule rule ; case checkUselessSpecPrag poly_id rule_lhs_args spec_bndrs - no_act_spec (unsetInlinePragmaArity spec_inl) rule_act of + no_act_spec spec_inl rule_act of Nothing -> return (Just result) Just reason -> do { diagnosticDs $ DsUselessSpecialisePragma poly_nm is_dfun reason @@ -1111,7 +1114,7 @@ decomposeCall poly_id ds_call -- Is this SPECIALISE pragma useless? checkUselessSpecPrag :: Id -> [CoreExpr] - -> [Var] -> Bool -> InlinePragma GhcPs -> Activation + -> [Var] -> Bool -> InlinePragma (GhcPass p) -> Activation -> Maybe UselessSpecialisePragmaReason checkUselessSpecPrag poly_id rule_lhs_args spec_bndrs no_act_spec spec_inl rule_act @@ -1187,19 +1190,17 @@ getCastedVar (Var v) = Just (v, MRefl) getCastedVar (Cast (Var v) co) = Just (v, MCo co) getCastedVar _ = Nothing -specFunInlinePrag :: Id -> InlinePragma GhcTc - -> InlinePragma GhcTc -> InlinePragma GhcTc +--specFunInlinePrag :: forall p. IsPass p => Id -> InlinePragma (GhcPass p) -> InlinePragma (GhcPass p) -> InlinePragma (GhcPass p) +specFunInlinePrag :: Id -> InlinePragma GhcRn -> InlinePragma GhcRn -> InlinePragma GhcRn -- See Note [Activation pragmas for SPECIALISE] specFunInlinePrag poly_id id_inl spec_inl | not (isDefaultInlinePragma spec_inl) = spec_inl | isGlobalId poly_id -- See Note [Specialising imported functions] -- in OccurAnal - , isStrongLoopBreaker (idOccInfo poly_id) = neverInlinePragma `setInlinePragmaArity` arity + , isStrongLoopBreaker (idOccInfo poly_id) = neverInlinePragma | otherwise = id_inl -- Get the INLINE pragma from SPECIALISE declaration, or, -- failing that, from the original Id - where - arity = arityInfo $ idInfo poly_id dsWarnOrphanRule :: CoreRule -> DsM () dsWarnOrphanRule rule ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -1103,7 +1103,7 @@ renameSig ctxt sig@(SpecSig _ v tys inl) TopSigCtxt {} -> lookupLocatedOccRn WL_TermVariable v _ -> lookupSigOccRn ctxt sig v ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys - ; return (SpecSig noAnn new_v new_ty (inl `setInlinePragmaArity` 0), fvs) } -- TODO: setting arity to 0 is likely wrong + ; return (SpecSig noAnn new_v new_ty (setInlinePragmaArityAsNotExplicit inl), fvs) } where do_one (tys,fvs) ty = do { (new_ty, fvs_ty) <- rnHsSigType (SpecialiseSigCtx v) TypeLevel ty @@ -1114,11 +1114,11 @@ renameSig _ctxt (SpecSigE _ bndrs spec_e inl) ; fn_name <- lookupOccRn WL_TermVariable fn_rdr -- Checks that the head isn't forall-bound ; bindRuleBndrs (SpecECtx fn_rdr) bndrs $ \_ bndrs' -> do { (spec_e', fvs) <- rnLExpr spec_e - ; return (SpecSigE fn_name bndrs' spec_e' ( inl `setInlinePragmaArity` 0), fvs) } } -- TODO: setting arity to 0 is likely wrong + ; return (SpecSigE fn_name bndrs' spec_e' (setInlinePragmaArityAsNotExplicit inl), fvs) } } renameSig ctxt sig@(InlineSig _ v s) = do { new_v <- lookupSigOccRn ctxt sig v - ; return (InlineSig noAnn new_v ( s `setInlinePragmaArity` 0 ), emptyFVs) } -- TODO: setting arity to 0 is likely wrong + ; return (InlineSig noAnn new_v (setInlinePragmaArityAsNotExplicit s), emptyFVs) } renameSig ctxt (FixSig _ fsig) = do { new_fsig <- rnSrcFixityDecl ctxt fsig ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -604,7 +604,7 @@ addInlinePragArity _ sig = sig add_inl_arity :: Arity -> InlinePragma GhcRn -> InlinePragma GhcRn add_inl_arity ar prag@(InlinePragma { inl_inline = inl_spec }) | Inline {} <- inl_spec -- Add arity only for real INLINE pragmas, not INLINABLE - = prag `setInlinePragmaArity` ar + = prag `setInlinePragmaArityAsExplicitly` ar | otherwise = prag @@ -620,7 +620,7 @@ addInlinePrags poly_id prags_for_me | inl@(L _ prag) : inls <- inl_prags = do { traceTc "addInlinePrag" (ppr poly_id $$ ppr prag) ; unless (null inls) (warn_multiple_inlines inl inls) - ; return (poly_id `setInlinePragma` prag) } + ; return (poly_id `setInlinePragma` demoteInlinePragmaTc prag) } | otherwise = return poly_id where ===================================== compiler/GHC/Tc/Instance/Typeable.hs ===================================== @@ -13,7 +13,7 @@ import GHC.Prelude import GHC.Platform import GHC.Types.Basic ( TypeOrConstraint(..) ) -import GHC.Types.InlinePragma ( neverInlinePragma, setInlinePragmaArity ) +import GHC.Types.InlinePragma ( neverInlinePragma ) import GHC.Types.SourceText ( SourceText(..) ) import GHC.Iface.Env( newGlobalBinder ) import GHC.Core.TyCo.Rep( Type(..), TyLit(..) ) @@ -554,8 +554,7 @@ getKindRep stuff@(Stuff {..}) in_scope = go | otherwise = do -- Place a NOINLINE pragma on KindReps since they tend to be quite -- large and bloat interface files. - let prag = neverInlinePragma `setInlinePragmaArity` 0 - rep_bndr <- (`setInlinePragma` prag) + rep_bndr <- (`setInlinePragma` neverInlinePragma) <$> newSysLocalId (fsLit "$krep") ManyTy (mkTyConTy kindRepTyCon) -- do we need to tie a knot here? ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -70,7 +70,6 @@ import GHC.Types.Var.Env import GHC.Types.Var.Set import GHC.Types.Basic import GHC.Types.Id -import GHC.Types.Id.Info (arityInfo) import GHC.Types.InlinePragma import GHC.Types.SourceFile import GHC.Types.SourceText @@ -1429,10 +1428,9 @@ addDFunPrags :: DFunId -> [Id] -> DFunId -- is messing with. addDFunPrags dfun_id sc_meth_ids = dfun_id `setIdUnfolding` mkDFunUnfolding dfun_bndrs dict_con dict_args - `setInlinePragma` (dfunInlinePragma `setInlinePragmaArity` arity) -- NOTE: Check if this arity calculation is correct + `setInlinePragma` dfunInlinePragma -- NB: mkDFunUnfolding takes care of unary classes where - arity = length var_apps dict_args = map Type inst_tys ++ var_apps var_apps = [mkVarApps (Var id) dfun_bndrs | id <- sc_meth_ids] @@ -2267,7 +2265,7 @@ mkDefMethBind loc dfun_id clas sel_id dm_name dm_spec = do { logger <- getLogger ; dm_id <- tcLookupId dm_name ; let inline_prag :: InlinePragma GhcRn - inline_prag = demoteInlinePragmaRn $ idInlinePragma dm_id + inline_prag = idInlinePragma dm_id inline_prags | isAnyInlinePragma inline_prag = [noLocA (InlineSig noAnn fn inline_prag)] | otherwise @@ -2669,11 +2667,9 @@ tcSpecInstPrags dfun_id (InstBindings { ib_binds = binds, ib_pragmas = uprags }) tcSpecInst :: Id -> Sig GhcRn -> TcM TcSpecPrag tcSpecInst dfun_id prag@(SpecInstSig _ hs_ty) = addErrCtxt (SpecPragmaCtxt prag) $ - let arity = arityInfo $ idInfo dfun_id - prag = defaultInlinePragma `setInlinePragmaArity` arity - in do { spec_dfun_ty <- tcHsClsInstType SpecInstCtxt hs_ty - ; co_fn <- tcSpecWrapper SpecInstCtxt (idType dfun_id) spec_dfun_ty - ; return (SpecPrag dfun_id co_fn prag) } + do { spec_dfun_ty <- tcHsClsInstType SpecInstCtxt hs_ty + ; co_fn <- tcSpecWrapper SpecInstCtxt (idType dfun_id) spec_dfun_ty + ; return (SpecPrag dfun_id co_fn defaultInlinePragma) } tcSpecInst _ _ = panic "tcSpecInst" ===================================== compiler/GHC/Types/Arity.hs ===================================== @@ -6,14 +6,18 @@ module GHC.Types.Arity ( Arity - , VisArity - , RepArity - , JoinArity , FullArgCount + , InlineArity(..) + , JoinArity + , RepArity + , VisArity ) where import GHC.Prelude +import Control.DeepSeq (NFData(..)) +import Data.Data (Data) + {- ************************************************************************ * * @@ -29,9 +33,29 @@ import GHC.Prelude -- See also Note [Definition of arity] in "GHC.Core.Opt.Arity" type Arity = Int --- | Syntactic (visibility) arity, i.e. the number of visible arguments. --- See Note [Visibility and arity] -type VisArity = Int +-- | FullArgCount is the number of type or value arguments in an application, +-- or the number of type or value binders in a lambda. Note: it includes +-- both type and value arguments! +type FullArgCount = Int + +-- | The arity /at which to/ inline a function. +-- This may differ from the function's syntactic arity. +data InlineArity + = ArityExplicitly !Word + -- ^ Inline only when applied to @n@ explicit + -- (non-type, non-dictionary) arguments. + -- + -- That is, 'ArityExplicitly' describes the number of + -- *source-code* arguments the thing must be applied to. + | ArityNotExplicit + -- ^ There does not exist an explicit number of arguments + -- that the inlining process should be applied to. + deriving (Eq, Data) + +instance NFData InlineArity where + + rnf (ArityExplicitly !w) = rnf w `seq` () + rnf !ArityNotExplicit = () -- | Representation Arity -- @@ -48,10 +72,9 @@ type RepArity = Int -- are counted. type JoinArity = Int --- | FullArgCount is the number of type or value arguments in an application, --- or the number of type or value binders in a lambda. Note: it includes --- both type and value arguments! -type FullArgCount = Int +-- | Syntactic (visibility) arity, i.e. the number of visible arguments. +-- See Note [Visibility and arity] +type VisArity = Int {- Note [Visibility and arity] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -1304,18 +1304,18 @@ failed Succeeded = False failed Failed = True {- -data InlinePragmaGhcTag = InlinePragmaGhcTag +data XInlinePragmaGhc = XInlinePragmaGhc { inl_ghcrn_src :: {-# UNPACK#-} !SourceText , inl_ghcrn_arity :: {-# UNPACK#-} !Arity } deriving (Eq, Data) -instance NFData InlinePragmaGhcTag where - rnf (InlinePragmaGhcTag s a) = rnf s `seq` rnf a `seq` () +instance NFData XInlinePragmaGhc where + rnf (XInlinePragmaGhc s a) = rnf s `seq` rnf a `seq` () type instance XInlinePragma GhcPs = SourceText -type instance XInlinePragma GhcRn = InlinePragmaGhcTag -type instance XInlinePragma GhcTc = InlinePragmaGhcTag +type instance XInlinePragma GhcRn = XInlinePragmaGhc +type instance XInlinePragma GhcTc = XInlinePragmaGhc type instance XXInlinePragma (GhcPass _) = DataConCantHappen defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma @@ -1339,7 +1339,7 @@ dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive setInlinePragmaArity :: InlinePragma GhcPs -> Arity -> InlinePragma GhcTc setInlinePragmaArity prag@(InlinePragma { inl_ext = srcTxt }) arity = - prag { inl_ext = InlinePragmaGhcTag srcTxt arity } + prag { inl_ext = XInlinePragmaGhc srcTxt arity } inlinePragmaSource :: forall p. IsPass p => InlinePragma (GhcPass p) -> SourceText ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -150,7 +150,7 @@ import GHC.Core.DataCon import GHC.Core.Class import GHC.Core.Multiplicity -import GHC.Hs.Extension (GhcTc) +import GHC.Hs.Extension (GhcRn) import GHC.Types.RepType import GHC.Types.Demand @@ -944,13 +944,13 @@ The inline pragma tells us to be very keen to inline this Id, but it's still OK not to if optimisation is switched off. -} -idInlinePragma :: Id -> InlinePragma GhcTc +idInlinePragma :: Id -> InlinePragma GhcRn idInlinePragma id = inlinePragInfo (idInfo id) -setInlinePragma :: Id -> InlinePragma GhcTc -> Id +setInlinePragma :: Id -> InlinePragma GhcRn -> Id setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id -modifyInlinePragma :: Id -> (InlinePragma GhcTc -> InlinePragma GhcTc) -> Id +modifyInlinePragma :: Id -> (InlinePragma GhcRn -> InlinePragma GhcRn) -> Id modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id idInlineActivation :: Id -> Activation ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -106,10 +106,8 @@ import GHC.Unit.Module import GHC.Types.Demand import GHC.Types.Cpr import GHC.Types.InlinePragma -import GHC.Types.SourceText import {-# SOURCE #-} GHC.Tc.Utils.TcType ( ConcreteTyVars, noConcreteTyVars ) - import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Stg.EnforceEpt.TagSig @@ -441,7 +439,7 @@ data IdInfo -- See Note [Specialisations and RULES in IdInfo] realUnfoldingInfo :: Unfolding, -- ^ The 'Id's unfolding - inlinePragInfo :: InlinePragma GhcTc, + inlinePragInfo :: InlinePragma GhcRn, -- ^ Any inline pragma attached to the 'Id' occInfo :: OccInfo, -- ^ How the 'Id' occurs in the program @@ -554,16 +552,9 @@ tagSigInfo = tagSig setRuleInfo :: IdInfo -> RuleInfo -> IdInfo setRuleInfo info sp = sp `seq` info { ruleInfo = sp } ---setInlinePragInfo :: IdInfo -> InlinePragma GhcTc -> IdInfo ---setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } -setInlinePragInfo :: forall p. IsPass p => IdInfo -> InlinePragma (GhcPass p) -> IdInfo -setInlinePragInfo info pr@(InlinePragma { inl_ext = src }) = pr `seq` info { inlinePragInfo = pr { inl_ext = tag } } - where - tag :: InlinePragmaGhcTag - tag = case ghcPass @p of - GhcPs -> InlinePragmaGhcTag (src :: SourceText) 0 - GhcRn -> (src :: InlinePragmaGhcTag) - GhcTc -> (src :: InlinePragmaGhcTag) + +setInlinePragInfo :: IdInfo -> InlinePragma GhcRn -> IdInfo +setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } setOccInfo :: IdInfo -> OccInfo -> IdInfo setOccInfo info oc = oc `seq` info { occInfo = oc } @@ -630,7 +621,7 @@ vanillaIdInfo = IdInfo { ruleInfo = emptyRuleInfo, realUnfoldingInfo = noUnfolding, - inlinePragInfo = defaultInlinePragma `setInlinePragmaArity` 0, + inlinePragInfo = defaultInlinePragma, occInfo = noOccInfo, demandInfo = topDmd, dmdSigInfo = nopSig, ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -65,7 +65,7 @@ import GHC.Core.TyCon import GHC.Core.Class import GHC.Core.DataCon -import GHC.Hs.Extension (GhcPs, GhcTc) +import GHC.Hs.Extension (GhcRn) import GHC.Types.Literal import GHC.Types.RepType ( countFunRepArgs, typePrimRep ) @@ -608,8 +608,8 @@ mkDataConWorkId wkr_name data_con -- See Note [Strict fields in Core] `setLFInfo` wkr_lf_info - wkr_inline_prag :: InlinePragma GhcTc - wkr_inline_prag = alwaysInlineConLikePragma `setInlinePragmaArity` wkr_arity + wkr_inline_prag :: InlinePragma GhcRn + wkr_inline_prag = alwaysInlineConLikePragma wkr_arity = dataConRepArity data_con wkr_sig = mkClosedDmdSig wkr_dmds topDiv @@ -989,7 +989,7 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con ; return (unbox_fn expr) } -dataConWrapperInlinePragma :: InlinePragma GhcPs +dataConWrapperInlinePragma :: InlinePragma GhcRn -- See Note [DataCon wrappers are conlike] dataConWrapperInlinePragma = alwaysInlineConLikePragma @@ -1950,7 +1950,7 @@ nullAddrId :: Id -- a way to write this literal in Haskell. nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info where - info = noCafIdInfo `setInlinePragInfo` (alwaysInlinePragma `setInlinePragmaArity` 0 :: InlinePragma GhcTc) + info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma `setUnfoldingInfo` mkCompulsoryUnfolding (Lit nullAddrLit) ------------------------------------------------ ===================================== compiler/GHC/Types/InlinePragma.hs ===================================== @@ -6,7 +6,7 @@ (c) The GRASP/AQUA Project, Glasgow University, 1997-1998 -} -{-# OPTIONS_GHC -Wno-orphans #-} -- Binary InlinePragmaGhcTag, Binary InlinePragma +{-# OPTIONS_GHC -Wno-orphans #-} -- Binary XInlinePragmaGhc, Binary InlinePragma module GHC.Types.InlinePragma ( -- * Inline Pragma Encoding @@ -21,6 +21,7 @@ module GHC.Types.InlinePragma , neverInlinePragma -- *** Field accessors , inlinePragmaActivation + , inlinePragmaArity , inlinePragmaName , inlinePragmaRuleMatchInfo , inlinePragmaSource @@ -33,20 +34,22 @@ module GHC.Types.InlinePragma , isNoInlinePragma , isOpaquePragma -- *** Mutators + , setInlinePragmaSource + , setInlinePragmaArityAsExplicitly + , setInlinePragmaArityAsNotExplicit , setInlinePragmaActivation - , setInlinePragmaArity + , setInlinePragmaSpec , setInlinePragmaRuleMatchInfo -- *** GHC pass conversions - , demoteInlinePragmaRn + , demoteInlinePragmaTc , promoteInlinePragmaRn - , setInlinePragmaTag - , unsetInlinePragmaArity -- *** Pretty-printing , pprInline , pprInlineDebug -- ** Extensible record type for GhcRn & GhcTc - , InlinePragmaGhcTag(..) + , XInlinePragmaGhc(..) + , InlineArity(..) -- ** InlineSpec -- *** Data-type @@ -98,19 +101,26 @@ import {-# SOURCE #-} GHC.Hs.Extension import GHC.Data.FastString import GHC.Utils.Binary import GHC.Utils.Outputable -import GHC.Types.Arity (Arity) -import GHC.Types.SourceText +import GHC.Types.Arity (InlineArity(..)) +import GHC.Types.SourceText (SourceText(..)) import Control.DeepSeq (NFData(..)) -import Data.Data +import Data.Data (Data) import Language.Haskell.Syntax.Binds.InlinePragma import Language.Haskell.Syntax.Extension +-- infixl so you can say (prag `set` a `set` b) +infixl 1 `setInlinePragmaActivation`, + `setInlinePragmaArityAsExplicitly`, + `setInlinePragmaRuleMatchInfo`, + `setInlinePragmaSource`, + `setInlinePragmaSpec` + data XInlinePragmaGhc = XInlinePragmaGhc { xinl_src :: SourceText -- ^ See Note [Pragma source text] - , xinl_sat :: Maybe Arity - -- ^ @Just n@ <=> Inline only when applied to @n@ explicit + , xinl_sat :: InlineArity + -- ^ Inline only when applied to @n@ explicit -- (non-type, non-dictionary) arguments. -- -- That is, 'xinl_sat' describes the number of *source-code* @@ -120,33 +130,48 @@ data XInlinePragmaGhc = XInlinePragmaGhc } deriving (Eq, Data) -instance NFData InlinePragmaGhcTag where - rnf (InlinePragmaGhcTag s a) = rnf s `seq` rnf a `seq` () +instance NFData XInlinePragmaGhc where + rnf (XInlinePragmaGhc s a) = rnf s `seq` rnf a `seq` () type instance XInlinePragma GhcPs = SourceText -type instance XInlinePragma GhcRn = InlinePragmaGhcTag -type instance XInlinePragma GhcTc = InlinePragmaGhcTag +type instance XInlinePragma GhcRn = XInlinePragmaGhc +type instance XInlinePragma GhcTc = XInlinePragmaGhc type instance XXInlinePragma (GhcPass _) = DataConCantHappen -defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma - :: InlinePragma GhcPs -defaultInlinePragma = InlinePragma { inl_ext = SourceText $ fsLit "{-# INLINE" - , inl_act = AlwaysActive - , inl_rule = FunLike - , inl_inline = NoUserInlinePrag } - -alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline } -neverInlinePragma = defaultInlinePragma { inl_act = NeverActive } - -alwaysInlineConLikePragma :: InlinePragma GhcPs -alwaysInlineConLikePragma = alwaysInlinePragma { inl_rule = ConLike } +-- | The default 'InlinePragma' definition for GHC. +-- The type and value of 'inl_ext' provided will differ +-- between the passes of GHC. Consequently, it may be +-- necessary to apply type annotation at the call site +-- to help the type checker disambiguate the correct +-- type of 'inl_ext'. +defaultInlinePragma :: forall p. IsPass p => InlinePragma (GhcPass p) +defaultInlinePragma = + let srcTxt = SourceText $ fsLit "{-# INLINE" + inlExt = case ghcPass @p of + GhcPs -> srcTxt + GhcRn -> XInlinePragmaGhc srcTxt ArityNotExplicit + GhcTc -> XInlinePragmaGhc srcTxt ArityNotExplicit + in InlinePragma + { inl_ext = inlExt + , inl_act = AlwaysActive + , inl_rule = FunLike + , inl_inline = NoUserInlinePrag } + +-- | The default 'InlinePragma' definition for the "parser pass" of GHC. +alwaysInlinePragma, neverInlinePragma, alwaysInlineConLikePragma, dfunInlinePragma + :: forall p. IsPass p => InlinePragma (GhcPass p) + + +alwaysInlinePragma = (defaultInlinePragma @p) { inl_inline = Inline } +neverInlinePragma = (defaultInlinePragma @p) { inl_act = NeverActive } +alwaysInlineConLikePragma = (alwaysInlinePragma @p) { inl_rule = ConLike } -- A DFun has an always-active inline activation so that -- exprIsConApp_maybe can "see" its unfolding -- (However, its actual Unfolding is a DFunUnfolding, which is -- never inlined other than via exprIsConApp_maybe.) -dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive - , inl_rule = ConLike } +dfunInlinePragma = (defaultInlinePragma @p) { inl_act = AlwaysActive + , inl_rule = ConLike } isDefaultInlinePragma :: InlinePragma p -> Bool isDefaultInlinePragma (XInlinePragma _) = False @@ -155,28 +180,38 @@ isDefaultInlinePragma (InlinePragma { inl_act = activation , inl_inline = inline }) = noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info -setInlinePragmaArity :: forall p q. (IsPass p, XInlinePragma (GhcPass q) ~ InlinePragmaGhcTag) - => InlinePragma (GhcPass p) -> Arity -> InlinePragma (GhcPass q) +setInlinePragmaArity :: forall p q. (IsPass p, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc) + => InlinePragma (GhcPass p) -> InlineArity -> InlinePragma (GhcPass q) setInlinePragmaArity prag arity = - prag { inl_ext = InlinePragmaGhcTag (inlinePragmaSource prag) arity } + prag { inl_ext = XInlinePragmaGhc (inlinePragmaSource prag) arity } + +setInlinePragmaArityAsExplicitly :: forall a p q. (Integral a, IsPass p, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc) + => InlinePragma (GhcPass p) -> a -> InlinePragma (GhcPass q) +setInlinePragmaArityAsExplicitly prag intVal = prag `setInlinePragmaArity` arity + where + arity = ArityExplicitly . fromIntegral $ abs intVal -unsetInlinePragmaArity :: forall p. IsPass p => InlinePragma (GhcPass p) -> InlinePragma GhcPs -unsetInlinePragmaArity prag = - prag { inl_ext = inlinePragmaSource prag } +setInlinePragmaArityAsNotExplicit :: forall p q. (IsPass p, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc) + => InlinePragma (GhcPass p) -> InlinePragma (GhcPass q) +setInlinePragmaArityAsNotExplicit = flip setInlinePragmaArity ArityNotExplicit inlinePragmaSource :: forall p. IsPass p => InlinePragma (GhcPass p) -> SourceText inlinePragmaSource (InlinePragma { inl_ext = src }) = srcTxt where srcTxt = case ghcPass @p of GhcPs -> src - GhcRn -> inl_ghcrn_src src - GhcTc -> inl_ghcrn_src src + GhcRn -> xinl_src src + GhcTc -> xinl_src src + +inlinePragmaArity :: forall p. (XInlinePragma (GhcPass p) ~ XInlinePragmaGhc) + => InlinePragma (GhcPass p) -> InlineArity +inlinePragmaArity = xinl_sat . inl_ext promoteInlinePragmaRn :: InlinePragma GhcRn -> InlinePragma GhcTc promoteInlinePragmaRn prag@(InlinePragma { inl_ext = src }) = prag { inl_ext = src } -demoteInlinePragmaRn :: InlinePragma GhcTc -> InlinePragma GhcRn -demoteInlinePragmaRn prag@(InlinePragma { inl_ext = src }) = prag { inl_ext = src } +demoteInlinePragmaTc :: InlinePragma GhcTc -> InlinePragma GhcRn +demoteInlinePragmaTc prag@(InlinePragma { inl_ext = src }) = prag { inl_ext = src } inlinePragmaSpec :: InlinePragma p -> InlineSpec inlinePragmaSpec = inl_inline @@ -187,8 +222,18 @@ inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation inlinePragmaRuleMatchInfo :: InlinePragma (GhcPass p) -> RuleMatchInfo inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info -setInlinePragmaTag :: InlinePragma (GhcPass p) -> XInlinePragma (GhcPass q) -> InlinePragma (GhcPass q) -setInlinePragmaTag prag tag = prag { inl_ext = tag } +setInlinePragmaSource :: forall p. IsPass p + => InlinePragma (GhcPass p) -> SourceText -> InlinePragma (GhcPass p) +setInlinePragmaSource prag srcTxt = prag { inl_ext = newExt } + where + oldExt = inl_ext prag + newExt = case ghcPass @p of + GhcPs -> srcTxt + GhcRn -> oldExt { xinl_src = srcTxt } + GhcTc -> oldExt { xinl_src = srcTxt } + +setInlinePragmaSpec :: InlinePragma (GhcPass p) -> InlineSpec -> InlinePragma (GhcPass p) +setInlinePragmaSpec prag spec = prag { inl_inline = spec } setInlinePragmaActivation :: InlinePragma (GhcPass p) -> Activation -> InlinePragma (GhcPass p) setInlinePragmaActivation prag activation = prag { inl_act = activation } @@ -360,15 +405,15 @@ no harm. modules once TTG has progressed and the Language.Haskell.Syntax.Types module no longer depends on importing GHC.Hs.Doc. -} -instance Binary InlinePragmaGhcTag where - put_ bh (InlinePragmaGhcTag s a) = do +instance Binary XInlinePragmaGhc where + put_ bh (XInlinePragmaGhc s a) = do put_ bh s put_ bh a get bh = do s <- get bh a <- get bh - return (InlinePragmaGhcTag s a) + return (XInlinePragmaGhc s a) instance forall p. IsPass p => Binary (InlinePragma (GhcPass p)) where put_ bh (InlinePragma s a b c) = do ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -125,6 +125,7 @@ import GHC.Data.FastString import GHC.Data.TrieMap import GHC.Utils.Exception import GHC.Utils.Panic.Plain +import GHC.Types.Arity (InlineArity(..)) import GHC.Types.Unique.FM import GHC.Data.FastMutInt import GHC.Utils.Fingerprint @@ -2064,28 +2065,21 @@ instance Binary FFIType where FFIUInt64 -> 11 instance Binary Activation where - put_ bh NeverActive = - putByte bh 0 - put_ bh FinalActive = do - putByte bh 1 - put_ bh AlwaysActive = - putByte bh 2 - put_ bh (ActiveBefore aa) = do - putByte bh 3 - put_ bh aa - put_ bh (ActiveAfter ab) = do - putByte bh 4 - put_ bh ab + put_ bh = \case + NeverActive -> putByte bh 0 + FinalActive -> putByte bh 1 + AlwaysActive -> putByte bh 2 + ActiveBefore aa -> putByte bh 3 *> put_ bh aa + ActiveAfter ab -> putByte bh 4 *> put_ bh ab + get bh = do - h <- getByte bh - case h of - 0 -> return NeverActive - 1 -> return FinalActive - 2 -> return AlwaysActive - 3 -> do aa <- get bh - return (ActiveBefore aa) - _ -> do ab <- get bh - return (ActiveAfter ab) + h <- getByte bh + case h of + 0 -> pure NeverActive + 1 -> pure FinalActive + 2 -> pure AlwaysActive + 3 -> ActiveBefore <$> get bh + _ -> ActiveAfter <$> get bh instance Binary InlineSpec where put_ bh = putByte bh . \case @@ -2095,18 +2089,29 @@ instance Binary InlineSpec where NoInline -> 3 Opaque -> 4 - get bh = do h <- getByte bh - return $ case h of - 0 -> NoUserInlinePrag - 1 -> Inline - 2 -> Inlinable - 3 -> NoInline - _ -> Opaque + get bh = do + h <- getByte bh + return $ case h of + 0 -> NoUserInlinePrag + 1 -> Inline + 2 -> Inlinable + 3 -> NoInline + _ -> Opaque instance Binary RuleMatchInfo where put_ bh FunLike = putByte bh 0 put_ bh ConLike = putByte bh 1 + + get bh = do + h <- getByte bh + if h == 1 then pure ConLike + else pure FunLike + +instance Binary InlineArity where + put_ bh ArityNotExplicit = putByte bh 0 + put_ bh (ArityExplicitly w) = putByte bh 1 *> put_ bh w + get bh = do - h <- getByte bh - if h == 1 then return ConLike - else return FunLike + h <- getByte bh + if h == 0 then pure ArityNotExplicit + else ArityExplicitly <$> get bh ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -112,6 +112,7 @@ module GHC.Utils.Outputable ( ) where import Language.Haskell.Syntax.Binds.InlinePragma +import Language.Haskell.Syntax.Extension ( dataConCantHappen ) import Language.Haskell.Syntax.Module.Name ( ModuleName(..) ) import {-# SOURCE #-} GHC.Hs.Extension @@ -2025,7 +2026,15 @@ pprInlineDebug = pprInline' False pprInline' :: Bool -- True <=> do not display the inl_inline field -> InlinePragma (GhcPass p) -> SDoc -pprInline' _ (XInlinePragma ext) = dataConCantHappen ext +-- TODO: Revise this definition for XInlinePragma constructor. +-- The proper defintion is: +-- > pprInline' _ (XInlinePragma ext) = dataConCantHappen ext +-- We cannot add this proper definition until this module imports +-- 'GHC.Types.InlinePragma', instead of the other way around. +-- Until then, the type family definition of XInlinePragma (GhcPass _) +-- will not be in scope and the type-checker cannot determine that +-- the binding 'ext' is in fact a 'DataConCantHappen' value. +pprInline' _ (XInlinePragma ext) = error "XInlinePragma = dataConCantHappen" pprInline' emptyInline (InlinePragma { inl_inline = inline, inl_act = activation, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7d47d203034f014791a2aa2cfb8fd2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7d47d203034f014791a2aa2cfb8fd2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/cleanup-win32-tarballs
by Cheng Shao (＠TerrorJack) 18 Dec '25

18 Dec '25

Cheng Shao pushed new branch wip/cleanup-win32-tarballs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/cleanup-win32-tarballs You're receiving this email because of your account on gitlab.haskell.org.

1 0