- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/fix-26670] Decoupling Language.Haskell.Syntax.Binds from GHC.Types.Basic by transfering...
by recursion-ninja (＠recursion-ninja) 20 Dec '25

20 Dec '25

recursion-ninja pushed to branch wip/fix-26670 at Glasgow Haskell Compiler / GHC Commits: 67d03c6b by Recursion Ninja at 2025-12-19T18:24:46-05:00 Decoupling Language.Haskell.Syntax.Binds from GHC.Types.Basic by transfering InlinePragma types between the modules. * Moved InlinePragma data-types to Language.Haskell.Syntax.Binds.InlinePragma * Partitioned of Arity type synonyms to GHC.Types.Arity * InlinePragma is now extensible via Trees That Grow * Activation is now extensible via Trees That Grow * Maybe Arity change to more descriptive InlineSaturation data-type * InlineSaturation information removed from InlinePragma during GHS parsing pass * Cleaned up the exposed module interfaces of the new modules - - - - - 65 changed files: - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Pipeline/Types.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - + compiler/GHC/Types/Arity.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Hint.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 - compiler/Language/Haskell/Syntax/Binds.hs - + compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Type.hs-boot - compiler/ghc.cabal.in - libraries/exceptions The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67d03c6bef286f470327a66fac52bb8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67d03c6bef286f470327a66fac52bb8… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Remove unused known-key and name variables for generics
by Marge Bot (＠marge-bot) 20 Dec '25

20 Dec '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job 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. - - - - - 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. - - - - - 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> - - - - - 4011f64c by Cheng Shao at 2025-12-19T17:46:21-05:00 rts: workaround -Werror=maybe-uninitialized false positives In some cases gcc might report -Werror=maybe-uninitialized that we know are false positives, but need to workaround it to make validate builds with -Werror pass. - - - - - bb3c938f by Cheng Shao at 2025-12-19T17:46:21-05:00 hadrian: use -Og as C/C++ optimization level when debugging This commit enables -Og as optimization level when compiling the debug ways of rts. According to gcc documentation (https://gcc.gnu.org/onlinedocs/gcc/Optimize-Options.html#index-Og) -Og is a better choice than -O0 for producing debuggable code. It's also supported by clang as well, so it makes sense to use it as a default for debugging. Also add missing -g3 flag to C++ compilation flags in +debug_info flavour transformer. - - - - - f5507684 by Cheng Shao at 2025-12-19T17:46:22-05:00 compiler: replace DList with OrdList This patch removes `DList` logic from the compiler and replaces it with `OrdList` which also supports O(1) concatenation and should be more memory efficient than the church-encoded `DList`. - - - - - 14 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/Parser/String.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - docs/users_guide/wasm.rst - hadrian/src/Flavour.hs - hadrian/src/Settings/Packages.hs - rts/linker/InitFini.c - rts/sm/Sanity.c - 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/Builtin/Names.hs ===================================== @@ -476,7 +476,6 @@ basicKnownKeyNames -- Generics , genClassName, gen1ClassName - , datatypeClassName, constructorClassName, selectorClassName -- Monad comprehensions , guardMName @@ -517,12 +516,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 +935,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 +951,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 +964,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 @@ -1494,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] @@ -1753,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 @@ -1950,11 +1925,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 +1934,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 +1947,6 @@ s1TyConKey = mkPreludeTyConUnique 153 repTyConKey = mkPreludeTyConUnique 155 rep1TyConKey = mkPreludeTyConUnique 156 -uRecTyConKey = mkPreludeTyConUnique 157 uAddrTyConKey = mkPreludeTyConUnique 158 uCharTyConKey = mkPreludeTyConUnique 159 uDoubleTyConKey = mkPreludeTyConUnique 160 ===================================== 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 = ===================================== compiler/GHC/Parser/String.hs ===================================== @@ -19,6 +19,7 @@ import Data.Char (chr, ord) import qualified Data.Foldable1 as Foldable1 import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (listToMaybe, mapMaybe) +import GHC.Data.OrdList (fromOL, nilOL, snocOL) import GHC.Data.StringBuffer (StringBuffer) import qualified GHC.Data.StringBuffer as StringBuffer import GHC.Parser.CharClass ( @@ -167,16 +168,16 @@ collapseGaps = go [] -> panic "gap unexpectedly ended" resolveEscapes :: HasChar c => [c] -> Either (c, LexErr) [c] -resolveEscapes = go dlistEmpty +resolveEscapes = go nilOL where go !acc = \case - [] -> pure $ dlistToList acc + [] -> pure $ fromOL acc Char '\\' : Char '&' : cs -> go acc cs backslash@(Char '\\') : cs -> case resolveEscapeChar cs of - Right (esc, cs') -> go (acc `dlistSnoc` setChar esc backslash) cs' + Right (esc, cs') -> go (acc `snocOL` setChar esc backslash) cs' Left (c, e) -> Left (c, e) - c : cs -> go (acc `dlistSnoc` c) cs + c : cs -> go (acc `snocOL` c) cs -- ----------------------------------------------------------------------------- -- Escape characters @@ -420,17 +421,3 @@ It's more precisely defined with the following algorithm: * Lines with only whitespace characters 3. Calculate the longest prefix of whitespace shared by all lines in the remaining list -} - --- ----------------------------------------------------------------------------- --- DList - -newtype DList a = DList ([a] -> [a]) - -dlistEmpty :: DList a -dlistEmpty = DList id - -dlistToList :: DList a -> [a] -dlistToList (DList f) = f [] - -dlistSnoc :: DList a -> a -> DList a -dlistSnoc (DList f) x = DList (f . (x :)) ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -11,6 +11,7 @@ import GHC.IO (unsafePerformIO) #endif import Data.Char +import Data.Foldable import GHC.Prelude import GHC.Platform import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) @@ -18,6 +19,7 @@ import GHC.Types.Unique.DSM import GHC.Unit.Module import GHC.Utils.Outputable import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..)) +import GHC.Data.OrdList (OrdList, nilOL, snocOL) import GHC.Cmm import GHC.Cmm.CLabel @@ -286,7 +288,7 @@ data CgInfoProvEnt = CgInfoProvEnt , ipeSrcSpan :: !StrTabOffset } -data StringTable = StringTable { stStrings :: DList ShortText +data StringTable = StringTable { stStrings :: !(OrdList ShortText) , stLength :: !Int , stLookup :: !(M.Map ShortText StrTabOffset) } @@ -295,7 +297,7 @@ type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = - StringTable { stStrings = emptyDList + StringTable { stStrings = nilOL , stLength = 0 , stLookup = M.empty } @@ -303,7 +305,7 @@ emptyStringTable = getStringTableStrings :: StringTable -> BS.ByteString getStringTableStrings st = BSL.toStrict $ BSB.toLazyByteString - $ foldMap f $ dlistToList (stStrings st) + $ foldMap' f $ stStrings st where f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0 @@ -312,7 +314,7 @@ lookupStringTable str = state $ \st -> case M.lookup str (stLookup st) of Just off -> (off, st) Nothing -> - let !st' = st { stStrings = stStrings st `snoc` str + let !st' = st { stStrings = stStrings st `snocOL` str , stLength = stLength st + ST.byteLength str + 1 , stLookup = M.insert str res (stLookup st) } @@ -359,14 +361,3 @@ foreign import ccall unsafe "ZSTD_compressBound" defaultCompressionLevel :: Int defaultCompressionLevel = 3 - -newtype DList a = DList ([a] -> [a]) - -emptyDList :: DList a -emptyDList = DList id - -snoc :: DList a -> a -> DList a -snoc (DList f) x = DList (f . (x:)) - -dlistToList :: DList a -> [a] -dlistToList (DList f) = f [] ===================================== 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 ===================================== hadrian/src/Flavour.hs ===================================== @@ -169,6 +169,7 @@ enableDebugInfo :: Flavour -> Flavour enableDebugInfo = addArgs $ notStage0 ? mconcat [ builder (Ghc CompileHs) ? pure ["-g3"] , builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"] + , builder (Ghc CompileCppWithGhc) ? pure ["-optcxx-g3"] , builder (Cc CompileC) ? arg "-g3" , builder (Cabal Setup) ? arg "--disable-library-stripping" , builder (Cabal Setup) ? arg "--disable-executable-stripping" ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -351,7 +351,7 @@ rtsPackageArgs = package rts ? do , Debug `wayUnit` way ? pure [ "-DDEBUG" , "-fno-omit-frame-pointer" , "-g3" - , "-O0" ] + , "-Og" ] -- Set the namespace for the rts fs functions , arg $ "-DFS_NAMESPACE=rts" ===================================== rts/linker/InitFini.c ===================================== @@ -75,7 +75,7 @@ static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) while (*last != NULL && (*last)->next != NULL) { struct InitFiniList *s0 = *last; struct InitFiniList *s1 = s0->next; - bool flip; + bool flip = false; switch (order) { case INCREASING: flip = s0->priority > s1->priority; break; case DECREASING: flip = s0->priority < s1->priority; break; ===================================== rts/sm/Sanity.c ===================================== @@ -692,7 +692,7 @@ checkCompactObjects(bdescr *bd) ASSERT((W_)str == (W_)block + sizeof(StgCompactNFDataBlock)); StgWord totalW = 0; - StgCompactNFDataBlock *last; + StgCompactNFDataBlock *last = block; for ( ; block ; block = block->next) { last = block; ASSERT(block->owner == str); ===================================== 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/-/compare/d02245f603cd5170668cb58264f0b4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d02245f603cd5170668cb58264f0b4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26670] 19 commits: X86 CodeGen: fix assign_eax_sse_regs
by recursion-ninja (＠recursion-ninja) 20 Dec '25

20 Dec '25

recursion-ninja pushed to branch wip/fix-26670 at Glasgow Haskell Compiler / GHC Commits: fca9cd7c by sheaf at 2025-12-18T13:18:18-05:00 X86 CodeGen: fix assign_eax_sse_regs We must set %al to the number of SSE2 registers that contain arguments (in case we are dealing with a varargs function). The logic for counting how many arguments reside in SSE2 registers was incorrect, as it used 'isFloatFormat', which incorrectly ignores vector registers. We now instead do case analysis on the register class: is_sse_reg r = case targetClassOfReg platform r of RcFloatOrVector -> True RcInteger -> False This change is necessary to prevent segfaults in T20030_test1j, because subsequent commits change the format calculations, resulting in vector formats more often. - - - - - 53150617 by sheaf at 2025-12-18T13:18:19-05:00 X86 regUsageOfInstr: fix format for IMUL When used with 8-bit operands, the IMUL instruction returns the result in the lower 16 bits of %rax (also known as %ax). This is different than for the other sizes, where an input at 16, 32 or 64 bits will result in 16, 32 or 64 bits of output in both %rax and %rdx. This doesn't affect the behaviour of the compiler, because we don't allow partial writes at sub-word sizes. The rationale is explained in Wrinkle [Don't allow scalar partial writes] in Note [Register formats in liveness analysis], in GHC.CmmToAsm.Reg.Liveness. - - - - - c7a56dd1 by sheaf at 2025-12-18T13:18:19-05:00 Liveness analysis: consider register formats This commit updates the register allocator to be a bit more careful in situations in which a single register is used at multiple different formats, e.g. when xmm1 is used both to store a Double# and a DoubleX2#. This is done by introducing the 'Regs' newtype around 'UniqSet RegWithFormat', for which the combining operations take the larger of the two formats instead of overriding the format. Operations on 'Regs' are defined in 'GHC.CmmToAsm.Reg.Regs'. There is a modest compile-time cost for the additional overhead for tracking register formats, which causes the metric increases of this commit. The subtle aspects of the implementation are outlined in Note [Register formats in liveness analysis] in GHC.CmmToAsm.Reg.Liveness. Fixes #26411 #26611 ------------------------- Metric Increase: T12707 T26425 T3294 ------------------------- - - - - - c2e83339 by sheaf at 2025-12-18T13:18:19-05:00 Register allocator: reload at same format as spill This commit ensures that if we spill a register onto the stack at a given format, we then always reload the register at this same format. This ensures we don't end up in a situation where we spill F64x2 but end up only reloading the lower F64. This first reload would make us believe the whole data is in a register, thus silently losing the upper 64 bits of the spilled register's contents. Fixes #26526 - - - - - 55ab583b by sheaf at 2025-12-18T13:18:19-05:00 Register allocation: writes redefine format As explained in Note [Allocated register formats] in GHC.CmmToAsm.Reg.Linear, we consider all writes to redefine the format of the register. This ensures that in a situation such as movsd .Ln6m(%rip),%v1 shufpd $0,%v1,%v1 we properly consider the broadcast operation to change the format of %v1 from F64 to F64x2. This completes the fix to #26411 (test in T26411b). - - - - - 951402ed by Vladislav Zavialov at 2025-12-18T13:19:05-05:00 Parser: improve mkModuleImpExp, remove checkImportSpec 1. The `mkModuleImpExp` helper now knows whether it is processing an import or export list item, and uses this information to produce a more accurate error message for `import M (T(..,x))` with PatternSynonyms disabled. The old message incorrectly referred to this case as an export form. 2. The `checkImportSpec` helper is removed in favor of more comprehensive error checking in `mkModuleImpExp`. 3. Additionaly, the invariants of `ImpExpList` and `ImpExpAllWith` have been made more explicit in the comments and assertions (calls to 'panic'). Test case: import-syntax-no-ext - - - - - 47d83d96 by Vladislav Zavialov at 2025-12-18T13:19:06-05:00 Subordinate namespace-specified wildcards (#25901) Add support for subordinate namespace-specified wildcards `X(type ..)` and `X(data ..)` to import and export lists. Examples: import M (Cls(type ..)) -- imports Cls and all its associated types import M (Cls(data ..)) -- imports Cls and all its methods module M (R(data ..), C(type ..)) where -- exports R and all its data constructors and record fields; -- exports C and all its associated types, but not its methods The scope of this change is limited to the case where the wildcard is the only subordinate import/export item, whereas the more complex forms `X(type .., f)` or `X(type .., data ..)` are unsupported and raise the newly introduced PsErrUnsupportedExplicitNamespace error. This restriction may be lifted later. Summary of the changes: 1. Refactor IEThingAll to store its extension field XIEThingAll as a record IEThingAllExt instead of a tuple. 2. Extend the AST by adding a NamespaceSpecifier field to IEThingAllExt, representing an optional namespace specifier `type` or `data` in front of a subordinate wildcard `X(..)`. 3. Extend the grammar in Parser.y with productions for `type ..` and `data ..` in subordinate import/export items. 4. Introduce `filterByNamespaceGREs` to filter [GlobalRdrElt] by a NamespaceSpecifier; use it in `filterImports` and `exports_from_avail` to account for the namespace specifier in IEThingAll. 5. Improve diagnostics by storing more information in DodgyImportsEmptyParent and DodgyExportsEmptyParent. Test cases: T25901_sub_e T25901_sub_f T25901_sub_g T25901_sub_a T25901_sub_b T25901_sub_c T25901_sub_d T25901_sub_w DodgyImports02 DodgyImports03 DodgyImports04 - - - - - eac418bb by Recursion Ninja at 2025-12-18T13:19:48-05:00 Removing the 'Data' instance for 'InstEnv'. The 'Data' instance is blocking work on Trees that Grow, and the 'Data' instance seem to have been added without a clear purpose. - - - - - e920e038 by Recursion Ninja at 2025-12-18T13:19:48-05:00 'Decouple Language.Haskell.Syntax.Decls' from 'GHC.Unit.Module.Warnings' - - - - - bd38b76c by Cheng Shao at 2025-12-18T13:20:31-05:00 testsuite: improve coverage of foundation test This patch refactors the `foundation` test a bit to improve coverage: - Instead of using a hard-coded seed, a random seed is now taken from the command line, and printed upon test failure. This improves test coverage over many future CI runs, and shall a failure occur, the seed is available in the CI log for local reproduction. - The iterations count is bumped to 1000 instead of 100, similar to the bump in `test-primops`. Runtime timeout is bumped 2x just to be safe. - Improve `newLCGGen` by using non-atomic loads/stores on a `MutableByteArray#` for storing mutable `Word64`, this test doesn't use parallelism in the first place - Fixed a few compiler warnings and removed redundant pragmas and imports Co-authored-by: Codex <codex(a)openai.com> - - - - - 3995187c by Sylvain Henry at 2025-12-18T13:21:45-05:00 Doc: document -pgmi "" (#26634) - - - - - 5729418c by Cheng Shao at 2025-12-18T13:22:29-05:00 rts: use __builtin_mul_overflow for hs_mulIntMayOflo This patch uses `__builtin_mul_overflow` to implement `hs_mulIntMayOflo`. This is a GNU C checked arithmetic builtin function supported by gcc/clang, is type-generic so works for both 32-bit/64-bit, and makes the code both more efficient and easier to read/maintain than the previous hand rolled logic. - - - - - 1ca4b49a by Cheng Shao at 2025-12-18T13:23:11-05:00 compiler/rts: fix ABI mismatch in barf() invocations This patch fixes a long-standing issue of ABI mismatch in `barf()` invocations, both in compiler-emitted code and in hand written Cmm code: - In RTS, we have `barf()` which reports a fatal internal error message and exits the program. - `barf()` is a variadic C function! When used as a callee of a foreign call with `ccall` calling convention instead of `capi`, there is an ABI mismatch between the caller and the callee! - Unfortunately, both the compiler and the Cmm sources contain many places where we call `barf()` via `ccall` convention!! Like, when you write `foreign "C" barf("foo object (%p) entered!", R1)`, it totally doesn't do what you think it'll do at all!! The second argument `R1` is not properly passed in `va_list`, and the behavior is completely undefined!! - Even more unfortunately, this issue has been sitting around long enough because the ABI mismatch is subtle enough on normie platforms like x64 and arm64. - But there are platforms like wasm32 that are stricter about ABI, and the broken `barf()` invocations already causes trouble for wasm backend: we had to use ugly hacks like `barf(errmsg, NULL)` to make `wasm-ld` happy, and even with this band-aid, compiler-generated `barf()` invocations are still broken, resulting in regressions in certain debug-related functionality, e.g. `-dtag-inference-checks` is broken on wasm32 (#22882). This patch properly fixes the issue: - We add non-variadic `barf` wrappers in the RTS that can be used as `ccall` callees - Both the compiler `emitBarf` logic and the hand-written Cmm are changed to call these wrappers - `emitBarf` now also properly annotates the foreign call as `CmmNeverReturns` to indicate it's a noreturn call to enable more efficient code generation `-dtag-inference-checks` now works on wasm. Closes #22882. Co-authored-by: Codex <codex(a)openai.com> - - - - - b3dd23b9 by Vilim Lendvaj at 2025-12-18T13:23:57-05:00 Remove outdated comment The Traversable instance for ZipList is no longer in GHC.Internal.Data.Traversable. In fact, it is right below this very comment. - - - - - 9a9c2f03 by Cheng Shao at 2025-12-18T13:24:39-05:00 compiler: remove unused OtherSection logic This patch removes the OtherSection logic in Cmm, given it's never actually used by any of our backends. - - - - - 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. - - - - - 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. - - - - - 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> - - - - - 6a5d9f45 by Recursion Ninja at 2025-12-19T17:34:14-05:00 Decoupling Language.Haskell.Syntax.Binds from GHC.Types.Basic by transfering InlinePragma types between the modules. * Moved InlinePragma data-types to Language.Haskell.Syntax.Binds.InlinePragma * Partitioned of Arity type synonyms to GHC.Types.Arity * InlinePragma is now extensible via Trees That Grow * Activation is now extensible via Trees That Grow * Maybe Arity change to more descriptive InlineSaturation data-type * InlineSaturation information removed from InlinePragma during GHS parsing pass * Cleaned up the exposed module interfaces of the new modules - - - - - 180 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/LA64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs - compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs - compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/Base.hs - compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - + compiler/GHC/CmmToAsm/Reg/Regs.hs - compiler/GHC/CmmToAsm/Reg/Target.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/Core.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Pipeline/Types.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Warnings.hs - compiler/GHC/IfaceToCore.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/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Utils.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - + compiler/GHC/Types/Arity.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/DefaultEnv.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.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/Types/Name/Reader.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Binds.hs - + compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Type.hs-boot - compiler/ghc.cabal.in - docs/users_guide/phases.rst - docs/users_guide/wasm.rst - libraries/exceptions - libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs - rts/Apply.cmm - rts/Compact.cmm - rts/ContinuationOps.cmm - rts/Exception.cmm - rts/Jumps.h - rts/PrimOps.cmm - rts/RtsMessages.c - rts/StgMiscClosures.cmm - rts/StgStartup.cmm - rts/include/Stg.h - rts/include/rts/Messages.h - rts/prim/mulIntMayOflo.c - testsuite/tests/diagnostic-codes/codes.stdout - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/jsffi/all.T - + testsuite/tests/jsffi/bytearrayarg.hs - + testsuite/tests/jsffi/bytearrayarg.mjs - + testsuite/tests/jsffi/bytearrayarg.stdout - testsuite/tests/numeric/should_run/all.T - testsuite/tests/numeric/should_run/foundation.hs - testsuite/tests/numeric/should_run/foundation.stdout - testsuite/tests/patsyn/should_fail/all.T - + testsuite/tests/patsyn/should_fail/import-syntax-no-ext.hs - + testsuite/tests/patsyn/should_fail/import-syntax-no-ext.stderr - testsuite/tests/perf/should_run/all.T - + testsuite/tests/rename/should_compile/T25901_sub_e.hs - + testsuite/tests/rename/should_compile/T25901_sub_f.hs - + testsuite/tests/rename/should_compile/T25901_sub_f.stderr - + testsuite/tests/rename/should_compile/T25901_sub_g.hs - + testsuite/tests/rename/should_compile/T25901_sub_g.stderr - + testsuite/tests/rename/should_compile/T25901_sub_g_helper.hs - testsuite/tests/rename/should_compile/all.T - testsuite/tests/rename/should_fail/T23570b.stderr - + testsuite/tests/rename/should_fail/T25901_sub_a.hs - + testsuite/tests/rename/should_fail/T25901_sub_a.stderr - + testsuite/tests/rename/should_fail/T25901_sub_b.hs - + testsuite/tests/rename/should_fail/T25901_sub_b.stderr - + testsuite/tests/rename/should_fail/T25901_sub_c.hs - + testsuite/tests/rename/should_fail/T25901_sub_c.stderr - + testsuite/tests/rename/should_fail/T25901_sub_c_helper.hs - + testsuite/tests/rename/should_fail/T25901_sub_d.hs - + testsuite/tests/rename/should_fail/T25901_sub_d.stderr - + testsuite/tests/rename/should_fail/T25901_sub_d_helper.hs - + testsuite/tests/rename/should_fail/T25901_sub_w.hs - + testsuite/tests/rename/should_fail/T25901_sub_w.stderr - testsuite/tests/rename/should_fail/all.T - + testsuite/tests/simd/should_run/T26411.hs - + testsuite/tests/simd/should_run/T26411.stdout - + testsuite/tests/simd/should_run/T26411b.hs - + testsuite/tests/simd/should_run/T26411b.stdout - testsuite/tests/simd/should_run/all.T - testsuite/tests/simplStg/should_compile/all.T - testsuite/tests/warnings/should_compile/DodgyExports03.stderr - testsuite/tests/warnings/should_compile/DodgyImports.stderr - + testsuite/tests/warnings/should_compile/DodgyImports02.hs - + testsuite/tests/warnings/should_compile/DodgyImports02.stderr - + testsuite/tests/warnings/should_compile/DodgyImports03.hs - + testsuite/tests/warnings/should_compile/DodgyImports03.stderr - + testsuite/tests/warnings/should_compile/DodgyImports03_helper.hs - + testsuite/tests/warnings/should_compile/DodgyImports04.hs - + testsuite/tests/warnings/should_compile/DodgyImports04.stderr - testsuite/tests/warnings/should_compile/DodgyImports_hiding.stderr - testsuite/tests/warnings/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/genapply/Main.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67723c02fecbfa94f179a167c40b55… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67723c02fecbfa94f179a167c40b55… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/25636] 2 commits: Decked out in tracs
by Rodrigo Mesquita (＠alt-romes) 20 Dec '25

20 Dec '25

Rodrigo Mesquita pushed to branch wip/romes/25636 at Glasgow Haskell Compiler / GHC Commits: cb1974a8 by Rodrigo Mesquita at 2025-12-19T22:28:03+00:00 Decked out in tracs - - - - - 0be5515a by Rodrigo Mesquita at 2025-12-19T22:31:57+00:00 Kill traces - - - - - 5 changed files: - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/StgToByteCode.hs - libraries/ghci/GHCi/CreateBCO.hs Changes: ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -298,8 +298,9 @@ data BCInstr instance Outputable ProtoBCO where ppr (ProtoStaticCon nm con args origin) - = text "ProtoStaticCon" <+> ppr nm <+> text "for constructor" <+> ppr con <> colon + = text "ProtoStaticCon" <+> ppr nm <> colon $$ nest 3 (pprStgRhsShort shortStgPprOpts origin) + $$ nest 3 (text "constructor: " <+> ppr con) $$ nest 3 (text "sorted args: " <+> ppr args) ppr (ProtoBCO { protoBCOName = name , protoBCOInstrs = instrs ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -79,14 +79,11 @@ linkBCO interp pkgs_loaded bytecode_state bco_ix unl_bco = do UnlinkedStaticCon { unlinkedStaticConLits = lits0 , unlinkedStaticConPtrs = ptrs0 + , unlinkedStaticConDataConName } -> do - pprTraceM "linkBCO: linking static constructor" (ppr unl_bco) - Ptr itbl_ptr# <- lookupIE interp pkgs_loaded bytecode_state (unlinkedStaticConDataConName unl_bco) - pprTraceM "linkBCO: itbl_ptr#" (ppr (unlinkedStaticConDataConName unl_bco) <+> text (show (Ptr itbl_ptr#))) + Ptr itbl_ptr# <- lookupIE interp pkgs_loaded bytecode_state unlinkedStaticConDataConName lits <- doLits lits0 - pprTraceM "linkBCO: lits done" (empty) ptrs <- doPtrs ptrs0 - pprTraceM "linkBCO: ptrs done" (empty) return ResolvedStaticCon { resolvedBCOIsLE = isLittleEndian , resolvedStaticConInfoPtr = W# (int2Word# (addr2Int# itbl_ptr#)) @@ -99,11 +96,11 @@ linkBCO interp pkgs_loaded bytecode_state bco_ix unl_bco = do (lits :: [Word]) <- mapM (lookupLiteral interp pkgs_loaded bytecode_state) (elemsFlatBag lits0) let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits return $ mkBCOByteArray lits' - doPtrs ptrs0 = addListToSS emptySS <$> + doPtrs ptrs0 = addListToSS emptySS <$> do mapM (resolvePtr interp pkgs_loaded bytecode_state bco_ix) (elemsFlatBag ptrs0) lookupLiteral :: Interp -> PkgsLoaded -> BytecodeLoaderState -> BCONPtr -> IO Word -lookupLiteral interp pkgs_loaded bytecode_state ptr = pprTrace "lookupLiteral" (ppr ptr) $ case ptr of +lookupLiteral interp pkgs_loaded bytecode_state ptr = case ptr of BCONPtrWord lit -> return lit BCONPtrLbl sym -> do Ptr a# <- lookupStaticPtr interp sym @@ -187,24 +184,20 @@ resolvePtr -> NameEnv (Int, Bool) -> BCOPtr -> IO ResolvedBCOPtr -resolvePtr interp pkgs_loaded bco_loader_state bco_ix ptr = pprTrace "resolvePtr" (ppr ptr) $ case ptr of +resolvePtr interp pkgs_loaded bco_loader_state bco_ix ptr = case ptr of BCOPtrName nm | Just (ix, b) <- lookupNameEnv bco_ix nm - -> if b then do - pprTraceM "resolvePtr: ResolvedBCORef" (ppr nm <+> ppr ix) + -> if b then return (ResolvedBCORef ix) -- ref to another BCO in this group - else do - pprTraceM "resolvePtr: StaticConRef" (ppr nm <+> ppr ix) + else return (ResolvedStaticConRef ix) -- ref to another StaticCon in this group | Just (_, rhv) <- lookupNameBytecodeState bco_loader_state nm - -> do - pprTraceM "resolvePtr: BCOPtr" (ppr nm) - return (ResolvedBCOPtr (unsafeForeignRefToRemoteRef rhv)) + -> return (ResolvedBCOPtr (unsafeForeignRefToRemoteRef rhv)) | otherwise -> assertPpr (isExternalName nm) (ppr nm) $ - pprTrace "resolvePtr: OTHERWISE? ASSERTION FIALURE?" (ppr nm) $ do + do let sym_to_find = IClosureSymbol nm m <- lookupHsSymbol interp pkgs_loaded sym_to_find case m of ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -1048,13 +1048,6 @@ linkSomeBCOs interp pkgs_loaded bytecode_state mods = foldr fun do_link mods [] UnlinkedStaticCon{unlinkedStaticConName} -> (unlinkedStaticConName, False) ) flat bco_ix = mkNameEnv (zipWith (\(n,isBCO) ix -> (n,(ix, isBCO))) names [0..]) - pprTraceM "linkSomeBCOs what" $ (ppr mods <+> ppr flat) - pprTraceM "linkSomeBCOs" $ - vcat [ text "Linking BCOs:" - , nest 2 (vcat (map (ppr . fst) names)) - , text "BCO index:" - , nest 2 (ppr bco_ix) - ] resolved <- sequence [ linkBCO interp pkgs_loaded bytecode_state bco_ix bco | bco <- flat ] hvrefs <- createBCOs interp resolved return (zipWith (\(n,_) hvr -> (n, hvr)) names hvrefs) ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -307,7 +307,6 @@ argBits platform (rep : args) schemeTopBind :: (Id, CgStgRhs) -> BcM ProtoBCO schemeTopBind (id, rhs@(StgRhsCon _ dc _ _ args _)) = do - pprTraceM "schemeTopBind: static con" (ppr id <+> ppr dc <+> ppr args) profile <- getProfile let non_voids = addArgReps (assertNonVoidStgArgs args) (_, _, args_offsets) ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -116,7 +116,7 @@ linkBCO' arr resolved_obj = IO $ \s -> case unsafeFreezeArray# marr s of { (# s, arr #) -> case newConAppObj# itbl_ptr# literals_barr arr data_size# s of - (# s, hval #) -> (# s, LinkedStaticCon (HValue hval) #) + (# s, hval #) -> (# s, LinkedStaticCon (HValue hval) #) } where !(EmptyArr empty#) = emptyArr -- See Note [BCO empty array] @@ -133,8 +133,9 @@ mkPtrsArray arr n_ptrs ptrs = do -- this MUST be /strict/! -- the static con reference must be an evaluated pointer to the data con -- info table, but (arr ! n) would construct a thunk instead if unforced. - let !hv = arr ! n - writePtrsArrayHValue i hv marr + let HValue !hv = arr ! n + -- let !hv = arr ! n -- this loops, but the above doesn't? something I didn't understand. + writePtrsArrayHValue i (HValue hv) marr fill (ResolvedBCOPtr r) i = do hv <- localRef r writePtrsArrayHValue i hv marr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c20b043b6a006361c1744c6886ad0c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c20b043b6a006361c1744c6886ad0c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mp/iface-patches-9.10] 6 commits: Replace `SizedSeq` with `FlatBag` for flattened structure
by Matthew Pickering (＠mpickering) 20 Dec '25

20 Dec '25

Matthew Pickering pushed to branch wip/mp/iface-patches-9.10 at Glasgow Haskell Compiler / GHC Commits: 0b16f517 by Fendor at 2025-12-19T10:13:20+00: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. (cherry picked from commit 45ab59dfe39ce32ec1db25644ed84bd44a9506f6) - - - - - add9f1c0 by Fendor at 2025-12-19T10:13:37+00: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`. (cherry picked from commit ac6a01bf3ef41460a5f0b4516c9784fa153e40b0) - - - - - 409aa3bc by Fendor at 2025-12-19T10:14:31+00:00 Prefer packed representation for CompiledByteCode As there are many 'CompiledByteCode' objects alive during a GHCi session, representing its element in a more packed manner improves space behaviour at a minimal cost. When running GHCi on the agda codebase, we find around 380 live 'CompiledByteCode' objects. Packing their respective 'UnlinkedByteCode' can save quite some pointers. (cherry picked from commit 0e00847fc15d76a3923029f072cb9e4bd62f6947) - - - - - 0cc7d458 by Fendor at 2025-12-19T10:19:12+00: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. - - - - - 1ecec34b by Fendor at 2025-12-19T10:23:59+00: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. - - - - - a92cf018 by Fendor at 2025-12-19T10:28:16+00: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. - - - - - 15 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Data/FastString.hs - + compiler/GHC/Data/FlatBag.hs - compiler/GHC/Data/SmallArray.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/StgToByteCode.hs - compiler/ghc.cabal.in - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/ResolvedBCO.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/ghci/should_run/BinaryArray.hs Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -34,6 +34,7 @@ import GHC.Utils.Panic import GHC.Core.TyCon import GHC.Data.FastString +import GHC.Data.FlatBag import GHC.Data.SizedSeq import GHC.StgToCmm.Layout ( ArgRep(..) ) @@ -71,9 +72,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 ] ) -- ----------------------------------------------------------------------------- @@ -90,7 +91,7 @@ bcoFreeNames bco assembleBCOs :: Interp -> Profile - -> [ProtoBCO Name] + -> FlatBag (ProtoBCO Name) -> [TyCon] -> AddrEnv -> Maybe ModBreaks @@ -129,7 +130,7 @@ assembleBCOs interp profile proto_bcos tycons top_strs modbreaks = do -- top-level string literal bindings] in GHC.StgToByteCode for some discussion -- about why. -- -mallocStrings :: Interp -> [UnlinkedBCO] -> IO [UnlinkedBCO] +mallocStrings :: Interp -> FlatBag UnlinkedBCO -> IO (FlatBag UnlinkedBCO) mallocStrings interp ulbcos = do let bytestrings = reverse (execState (mapM_ collect ulbcos) []) ptrs <- interpCmd interp (MallocStrings bytestrings) @@ -170,7 +171,7 @@ assembleOneBCO interp profile pbco = do -- TODO: the profile should be bundled with the interpreter: the rts ways are -- fixed for an interpreter ubco <- assembleBCO (profilePlatform profile) pbco - [ubco'] <- mallocStrings interp [ubco] + UnitFlatBag ubco' <- mallocStrings interp (UnitFlatBag ubco) return ubco' assembleBCO :: Platform -> ProtoBCO Name -> IO UnlinkedBCO @@ -213,9 +214,9 @@ 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 - ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr final_lits final_ptrs + !insns_arr = mkBCOByteArray $ Array.listArray (0 :: Int, fromIntegral n_insns - 1) asm_insns + !bitmap_arr = mkBCOByteArray $ mkBitmapArray bsize bitmap + 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 @@ -224,7 +225,7 @@ assembleBCO platform (ProtoBCO { protoBCOName = nm return ul_bco -mkBitmapArray :: Word -> [StgWord] -> UArray Int Word64 +mkBitmapArray :: Word -> [StgWord] -> UArray Int Word -- Here the return type must be an array of Words, not StgWords, -- because the underlying ByteArray# will end up as a component -- of a BCO object. ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -64,13 +64,13 @@ 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 pkgs_loaded le) (ssElts lits0) - ptrs <- mapM (resolvePtr interp pkgs_loaded le bco_ix) (ssElts ptrs0) - let lits' = listArray (0 :: Int, fromIntegral (sizeSS lits0)-1) lits + (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (elemsFlatBag lits0) + ptrs <- mapM (resolvePtr interp pkgs_loaded le bco_ix) (elemsFlatBag ptrs0) + let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits return (ResolvedBCO isLittleEndian arity insns bitmap - lits' + (mkBCOByteArray lits') (addListToSS emptySS ptrs)) lookupLiteral :: Interp -> PkgsLoaded -> 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,7 @@ -- | Bytecode assembler types module GHC.ByteCode.Types ( CompiledByteCode(..), seqCompiledByteCode + , BCOByteArray(..), mkBCOByteArray , FFIInfo(..) , RegBitmap(..) , NativeCallType(..), NativeCallInfo(..), voidTupleReturnInfo, voidPrimCallInfo @@ -18,12 +21,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 @@ -33,10 +37,10 @@ import GHCi.BreakArray import GHCi.RemoteTypes import GHCi.FFI import Control.DeepSeq +import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray ) import Foreign import Data.Array -import Data.Array.Base ( UArray(..) ) import Data.ByteString (ByteString) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap @@ -50,7 +54,7 @@ import Language.Haskell.Syntax.Module.Name (ModuleName) -- Compiled Byte Code data CompiledByteCode = CompiledByteCode - { bc_bcos :: [UnlinkedBCO] -- Bunch of interpretable bindings + { bc_bcos :: FlatBag UnlinkedBCO -- Bunch of interpretable bindings , bc_itbls :: ItblEnv -- A mapping from DataCons to their itbls , bc_ffis :: [FFIInfo] -- ffi blocks we allocated , bc_strs :: AddrEnv -- malloc'd top-level strings @@ -62,7 +66,7 @@ newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif) deriving (Show, NFData) instance Outputable CompiledByteCode where - ppr CompiledByteCode{..} = ppr bc_bcos + ppr CompiledByteCode{..} = ppr $ elemsFlatBag bc_bcos -- Not a real NFData instance, because ModBreaks contains some things -- we can't rnf @@ -152,10 +156,10 @@ data UnlinkedBCO = UnlinkedBCO { unlinkedBCOName :: !Name, unlinkedBCOArity :: {-# UNPACK #-} !Int, - unlinkedBCOInstrs :: !(UArray Int Word16), -- insns - unlinkedBCOBitmap :: !(UArray Int Word64), -- bitmap - unlinkedBCOLits :: !(SizedSeq BCONPtr), -- non-ptrs - unlinkedBCOPtrs :: !(SizedSeq BCOPtr) -- ptrs + unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns + unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap + unlinkedBCOLits :: !(FlatBag BCONPtr), -- non-ptrs + unlinkedBCOPtrs :: !(FlatBag BCOPtr) -- ptrs } instance NFData UnlinkedBCO where @@ -210,8 +214,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/FastString.hs ===================================== @@ -307,9 +307,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 ===================================== compiler/GHC/Data/FlatBag.hs ===================================== @@ -0,0 +1,129 @@ +{-# LANGUAGE UnboxedTuples #-} +module GHC.Data.FlatBag + ( FlatBag(EmptyFlatBag, UnitFlatBag, TupleFlatBag) + , 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/Iface/Type.hs ===================================== @@ -419,12 +419,51 @@ data IfaceTyConInfo -- Used only to guide pretty-printing , ifaceTyConSort :: IfaceTyConSort } deriving (Eq, Ord) --- This smart constructor allows sharing of the two most common --- cases. See #19194 +-- | This smart constructor allows sharing of the two most common +-- cases. See Note [Sharing IfaceTyConInfo] mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo -mkIfaceTyConInfo IsPromoted IfaceNormalTyCon = IfaceTyConInfo IsPromoted IfaceNormalTyCon -mkIfaceTyConInfo NotPromoted IfaceNormalTyCon = IfaceTyConInfo NotPromoted IfaceNormalTyCon -mkIfaceTyConInfo prom sort = IfaceTyConInfo prom sort +mkIfaceTyConInfo IsPromoted IfaceNormalTyCon = promotedNormalTyConInfo +mkIfaceTyConInfo NotPromoted IfaceNormalTyCon = notPromotedNormalTyConInfo +mkIfaceTyConInfo prom sort = IfaceTyConInfo prom sort + +{-# NOINLINE promotedNormalTyConInfo #-} +-- | See Note [Sharing IfaceTyConInfo] +promotedNormalTyConInfo :: IfaceTyConInfo +promotedNormalTyConInfo = IfaceTyConInfo IsPromoted IfaceNormalTyCon + +{-# NOINLINE notPromotedNormalTyConInfo #-} +-- | See Note [Sharing IfaceTyConInfo] +notPromotedNormalTyConInfo :: IfaceTyConInfo +notPromotedNormalTyConInfo = IfaceTyConInfo NotPromoted IfaceNormalTyCon + +{- +Note [Sharing IfaceTyConInfo] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +'IfaceTyConInfo' occurs an awful lot in 'ModIface', see #19194 for an example. +But almost all of them are + + IfaceTyConInfo IsPromoted IfaceNormalTyCon + IfaceTyConInfo NotPromoted IfaceNormalTyCon. + +The smart constructor `mkIfaceTyConInfo` arranges to share these instances, +thus: + + promotedNormalTyConInfo = IfaceTyConInfo IsPromoted IfaceNormalTyCon + notPromotedNormalTyConInfo = IfaceTyConInfo NotPromoted IfaceNormalTyCon + + mkIfaceTyConInfo IsPromoted IfaceNormalTyCon = promotedNormalTyConInfo + mkIfaceTyConInfo NotPromoted IfaceNormalTyCon = notPromotedNormalTyConInfo + mkIfaceTyConInfo prom sort = IfaceTyConInfo prom sort + +But ALAS, the (nested) CPR transform can lose this sharing, completely +negating the effect of `mkIfaceTyConInfo`: see #24530 and #19326. + +Sticking-plaster solution: add a NOINLINE pragma to those top-level constants. +When we fix the CPR bug we can remove the NOINLINE pragmas. + +This one change leads to an 15% reduction in residency for GHC when embedding +'mi_extra_decls': see !12222. +-} data IfaceMCoercion = IfaceMRefl ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -94,6 +94,7 @@ import Control.Monad import qualified Data.Set as Set import Data.Char (isSpace) import Data.Foldable (for_) +import qualified Data.Foldable as Foldable import Data.IORef import Data.List (intercalate, isPrefixOf, nub, partition, sortOn) import Data.Maybe @@ -947,7 +948,8 @@ linkSomeBCOs :: Interp linkSomeBCOs interp pkgs_loaded le mods = foldr fun do_link mods [] where - fun CompiledByteCode{..} inner accum = inner (bc_bcos : accum) + fun CompiledByteCode{..} inner accum = + inner (Foldable.toList bc_bcos : accum) do_link [] = return [] do_link mods = do ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -63,6 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU, import GHC.StgToCmm.Layout import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes) import GHC.Data.Bitmap +import GHC.Data.FlatBag as FlatBag import GHC.Data.OrdList import GHC.Data.Maybe import GHC.Types.Name.Env (mkNameEnv) @@ -119,14 +120,14 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks (BcM_State{..}, proto_bcos) <- runBc hsc_env this_mod mb_modBreaks $ do let flattened_binds = concatMap flattenBind (reverse lifted_binds) - mapM schemeTopBind flattened_binds + FlatBag.fromList (fromIntegral $ length flattened_binds) <$> mapM schemeTopBind flattened_binds when (notNull ffis) (panic "GHC.StgToByteCode.byteCodeGen: missing final emitBc?") putDumpFileMaybe logger Opt_D_dump_BCOs "Proto-BCOs" FormatByteCode - (vcat (intersperse (char ' ') (map ppr proto_bcos))) + (vcat (intersperse (char ' ') (map ppr $ elemsFlatBag proto_bcos))) cbc <- assembleBCOs interp profile proto_bcos tycs stringPtrs (case modBreaks of ===================================== compiler/ghc.cabal.in ===================================== @@ -415,6 +415,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 ===================================== 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,12 @@ {-# LANGUAGE RecordWildCards, DeriveGeneric, GeneralizedNewtypeDeriving, - BangPatterns, CPP #-} + BangPatterns, CPP, MagicHash, FlexibleInstances, FlexibleContexts, + TypeApplications, ScopedTypeVariables, UnboxedTuples #-} module GHCi.ResolvedBCO ( ResolvedBCO(..) , ResolvedBCOPtr(..) , isLittleEndian + , BCOByteArray(..) + , mkBCOByteArray ) where import Prelude -- See note [Why do we import Prelude here?] @@ -11,11 +14,19 @@ 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 Data.Array.Base (UArray(..)) + +import GHC.IO #include "MachDeps.h" @@ -32,19 +43,35 @@ 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 Word, -- bitmap + resolvedBCOLits :: BCOByteArray Word, -- 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# + } + +mkBCOByteArray :: UArray Int a -> BCOByteArray a +mkBCOByteArray (UArray _ _ _ arr) = BCOByteArray arr + +instance Show (BCOByteArray Word16) where + showsPrec _ _ = showString "BCOByteArray Word16" + +instance Show (BCOByteArray Word) where + showsPrec _ _ = showString "BCOByteArray Word" + -- | The Binary instance for ResolvedBCOs. -- -- Note, that we do encode the endianness, however there is no support for mixed @@ -54,12 +81,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 +106,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/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 ===================================== 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) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b15caeb035b418021ab45b259a33a3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b15caeb035b418021ab45b259a33a3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/known-key-removals/lift-m] Remove the unused known key and name for `liftM`
by Wolfgang Jeltsch (＠jeltsch) 20 Dec '25

20 Dec '25

Wolfgang Jeltsch pushed to branch wip/jeltsch/known-key-removals/lift-m at Glasgow Haskell Compiler / GHC Commits: ac199ae1 by Wolfgang Jeltsch at 2025-12-20T00:11:01+02:00 Remove the unused known key and name for `liftM` This removes the variables for the known key and the name of the `liftM` operation, 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 ===================================== @@ -479,7 +479,6 @@ basicKnownKeyNames -- Monad comprehensions , guardMName - , liftMName , mzipName -- GHCi Sandbox @@ -1544,9 +1543,8 @@ choiceAName = varQual gHC_INTERNAL_ARROW (fsLit "|||") choiceAIdKey loopAName = varQual gHC_INTERNAL_ARROW (fsLit "loop") loopAIdKey -- Monad comprehensions -guardMName, liftMName, mzipName :: Name +guardMName, mzipName :: Name guardMName = varQual gHC_INTERNAL_MONAD (fsLit "guard") guardMIdKey -liftMName = varQual gHC_INTERNAL_MONAD (fsLit "liftM") liftMIdKey mzipName = varQual gHC_INTERNAL_CONTROL_MONAD_ZIP (fsLit "mzip") mzipIdKey @@ -2436,9 +2434,8 @@ toIntegerClassOpKey = mkPreludeMiscIdUnique 192 toRationalClassOpKey = mkPreludeMiscIdUnique 193 -- Monad comprehensions -guardMIdKey, liftMIdKey, mzipIdKey :: Unique +guardMIdKey, mzipIdKey :: Unique guardMIdKey = mkPreludeMiscIdUnique 194 -liftMIdKey = mkPreludeMiscIdUnique 195 mzipIdKey = mkPreludeMiscIdUnique 196 -- GHCi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac199ae12d815a4d66c56801efd5a86… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac199ae12d815a4d66c56801efd5a86… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/jeltsch/known-key-removals/lift-m
by Wolfgang Jeltsch (＠jeltsch) 20 Dec '25

20 Dec '25

Wolfgang Jeltsch pushed new branch wip/jeltsch/known-key-removals/lift-m at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/jeltsch/known-key-removals/li… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/jeltsch/known-key-removals/fail-io
by Wolfgang Jeltsch (＠jeltsch) 20 Dec '25

20 Dec '25

Wolfgang Jeltsch pushed new branch wip/jeltsch/known-key-removals/fail-io at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/jeltsch/known-key-removals/fa… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/known-key-removals/fingerprints] Remove the unused known key and name for `Fingerprint`
by Wolfgang Jeltsch (＠jeltsch) 20 Dec '25

20 Dec '25

Wolfgang Jeltsch pushed to branch wip/jeltsch/known-key-removals/fingerprints at Glasgow Haskell Compiler / GHC Commits: 54082c5d by Wolfgang Jeltsch at 2025-12-19T23:59:24+02:00 Remove the unused known key and name for `Fingerprint` This removes the variables for the known key and the name of the `Fingerprint` data constructor, 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 ===================================== @@ -491,9 +491,6 @@ basicKnownKeyNames , staticPtrDataConName, staticPtrInfoDataConName , fromStaticPtrName - -- Fingerprint - , fingerprintDataConName - -- Custom type errors , errorMessageTypeErrorFamName , typeErrorTextDataConName @@ -1634,10 +1631,6 @@ fromStaticPtrName :: Name fromStaticPtrName = varQual gHC_INTERNAL_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey -fingerprintDataConName :: Name -fingerprintDataConName = - dcQual gHC_INTERNAL_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey - constPtrConName :: Name constPtrConName = tcQual gHC_INTERNAL_FOREIGN_C_CONSTPTR (fsLit "ConstPtr") constPtrTyConKey @@ -2123,9 +2116,6 @@ staticPtrDataConKey = mkPreludeDataConUnique 33 staticPtrInfoDataConKey :: Unique staticPtrInfoDataConKey = mkPreludeDataConUnique 34 -fingerprintDataConKey :: Unique -fingerprintDataConKey = mkPreludeDataConUnique 35 - srcLocDataConKey :: Unique srcLocDataConKey = mkPreludeDataConUnique 37 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/54082c5d7d27b0568be9667b95d55f9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/54082c5d7d27b0568be9667b95d55f9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/jeltsch/known-key-removals/fingerprints
by Wolfgang Jeltsch (＠jeltsch) 20 Dec '25

20 Dec '25

Wolfgang Jeltsch pushed new branch wip/jeltsch/known-key-removals/fingerprints at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/jeltsch/known-key-removals/fi… You're receiving this email because of your account on gitlab.haskell.org.

1 0