[Git][ghc/ghc][wip/decode_cloned_stack] 6 commits: Rename
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sun Apr 9 11:45:46 UTC 2023
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
a8197fc9 by Sven Tennie at 2023-04-09T08:44:19+00:00
Rename
- - - - -
a5fb3142 by Sven Tennie at 2023-04-09T08:50:48+00:00
getClosure returns Closure
- - - - -
30ec94ec by Sven Tennie at 2023-04-09T08:54:55+00:00
getClosure: One WordOffset is enough
- - - - -
048ba80b by Sven Tennie at 2023-04-09T08:59:38+00:00
getWord: One offset is enough
- - - - -
5a3a1bb3 by Sven Tennie at 2023-04-09T09:16:47+00:00
decodeBitmaps: One offset is enough
- - - - -
bb6ea826 by Sven Tennie at 2023-04-09T11:45:20+00:00
Formatting, notes
- - - - -
2 changed files:
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- libraries/ghc-heap/cbits/Stack.cmm
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
=====================================
@@ -6,7 +6,6 @@
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
@@ -26,9 +25,9 @@ import GHC.Exts
import GHC.Exts.Heap.ClosureTypes
import GHC.Exts.Heap.Closures
import GHC.Exts.Heap.Constants (wORD_SIZE_IN_BITS)
+import GHC.Exts.Heap.Decode
import GHC.Exts.Heap.InfoTable
import GHC.Exts.Stack.Constants
-import GHC.Exts.Heap.Decode
import GHC.IO (IO (..))
import GHC.Stack.CloneStack
import GHC.Word
@@ -43,38 +42,30 @@ simplified perspective) at any time.
The array of closures inside an StgStack (that makeup the execution stack; the
stack frames) is moved as bare memory by the garbage collector. References
-(pointers) to stack frames are not updated.
+(pointers) to stack frames are not updated by the garbage collector.
As the StgStack closure is moved as whole, the relative offsets inside it stay
the same. (Though, the absolute addresses change!)
-Stack frame iterator
+Decoding
====================
-A stack frame iterator (StackFrameIter) deals with the mentioned challenges
-regarding garbage collected memory. It consists of the StgStack itself and the
-mentioned offset (or index) where needed.
-
-It has three constructors:
+Stack frames are defined by their `StackSnapshot#` (`StgStack*` in RTS) and
+their relative offset. This tuple is described by `StackFrameLocation`.
-- SfiStackClosure: Represents the StgStack closure itself. As stacks are chained
- by underflow frames, there can be multiple StgStack closures per logical
- stack.
+`StackFrame` is an ADT for decoded stack frames. Where it points to heap located
+closures or primitive Words (in bitmap encoded payloads), `Closure` is used to
+describe the referenced payload.
-- SfiClosure: Represents a closure on the stack. The location on the stack is
- defined by the StgStack itself and an index into it.
+The decoding happens in two phases:
-- SfiPrimitive: Is structurally equivalent to SfiClosure, but represents a data
- Word on the stack. These appear as payloads to closures with bitmap layout.
- From the RTS-perspective, there's no information about the concrete type of
- the Word. So, it's just handled as Word in further processing.
+1. The whole stack is decoded into `StackFrameLocation`s.
-The `stackSnapshot# :: !StackSnapshot#` field represents a StgStack closure. It
-is updated by the garbage collector when the stack closure is moved.
+2. All `StackFrameLocation`s are decoded into `StackFrame`s which have
+`Closure`s as fields/references.
-The relative offset (index) describes the location of a stack frame on the
-stack. As stack frames come in various sizes, one cannot simply step over the
-stack array with a constant offset.
+`StackSnapshot#` parameters are updated by the garbage collector and thus safe
+to hand around.
The head of the stack frame array has offset (index) 0. To traverse the stack
frames the latest stack frame's offset is incremented by the closure size. The
@@ -83,16 +74,24 @@ unit of the offset is machine words (32bit or 64bit.)
Boxes
=====
-As references into the stack frame array aren't updated by the garbage collector,
-creating a Box with a pointer (address) to a stack frame would break as soon as
-the StgStack closure is moved.
+`Closure` makes extensive usage of `Box`es. Unfortunately, we cannot simply apply the
+same here:
+
+- Bitmap encoded payloads can be either words or closure pointers.
+
+- Underflow frames point to `StgStack` closures.
-To deal with this another kind of Box is introduced: A StackFrameBox contains a
-stack frame iterator (StackFrameIter).
+These three cases are hard to encode in boxes. Additionally, introducing new box
+types would break existing box usages. Thus, the stack is decoded unboxed, while
+the referenced `Closure`s use boxes. This seems to be a good compromise between
+optimization (with boxes) and simplicity (by leaving out the mentioned special
+cases.)
-Heap-represented closures referenced by stack frames are boxed the usual way,
-with a Box that contains a pointer to the closure as it's payload. In
-Haskell-land this means: A Box which contains the closure.
+IO
+==
+
+Unfortunately, ghc-heap decodes `Closure`s in `IO`. This leads to `StackFrames`
+also being decoded in `IO`, due to references to `Closure`s.
Technical details
=================
@@ -109,21 +108,24 @@ Technical details
This keeps the code very portable.
-}
-foreign import prim "getUnderflowFrameNextChunkzh" getUnderflowFrameNextChunk# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, StackSnapshot# #)
+foreign import prim "getUnderflowFrameNextChunkzh"
+ getUnderflowFrameNextChunk# ::
+ StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, StackSnapshot# #)
getUnderflowFrameNextChunk :: StackSnapshot# -> WordOffset -> IO StackSnapshot
getUnderflowFrameNextChunk stackSnapshot# index = IO $ \s ->
case getUnderflowFrameNextChunk# stackSnapshot# (wordOffsetToWord# index) s of
(# s1, stack# #) -> (# s1, StackSnapshot stack# #)
-foreign import prim "getWordzh" getWord# :: StackSnapshot# -> Word# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #)
+foreign import prim "getWordzh"
+ getWord# ::
+ StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #)
-getWord :: StackSnapshot# -> WordOffset -> WordOffset -> IO Word
-getWord stackSnapshot# index relativeOffset = IO $ \s ->
+getWord :: StackSnapshot# -> WordOffset -> IO Word
+getWord stackSnapshot# index = IO $ \s ->
case getWord#
stackSnapshot#
(wordOffsetToWord# index)
- (wordOffsetToWord# relativeOffset)
s of
(# s1, w# #) -> (# s1, W# w# #)
@@ -171,9 +173,13 @@ getInfoTableForStack stackSnapshot# =
peekItbl $
Ptr (getStackInfoTableAddr# stackSnapshot#)
-foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #)
+foreign import prim "getBoxedClosurezh"
+ getBoxedClosure# ::
+ StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #)
-foreign import prim "getStackFieldszh" getStackFields# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Word32#, Word8#, Word8# #)
+foreign import prim "getStackFieldszh"
+ getStackFields# ::
+ StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Word32#, Word8#, Word8# #)
getStackFields :: StackSnapshot# -> IO (Word32, Word8, Word8)
getStackFields stackSnapshot# = IO $ \s ->
@@ -183,13 +189,15 @@ getStackFields stackSnapshot# = IO $ \s ->
-- | Get an interator starting with the top-most stack frame
stackHead :: StackSnapshot -> (StackSnapshot, WordOffset)
-stackHead (StackSnapshot s#) = (StackSnapshot s#, 0 ) -- GHC stacks are never empty
+stackHead (StackSnapshot s#) = (StackSnapshot s#, 0) -- GHC stacks are never empty
-- | Advance to the next stack frame (if any)
--
-- The last `Int#` in the result tuple is meant to be treated as bool
-- (has_next).
-foreign import prim "advanceStackFrameIterzh" advanceStackFrameIter# :: StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #)
+foreign import prim "advanceStackFrameIterzh"
+ advanceStackFrameIter# ::
+ StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #)
-- | Advance iterator to the next stack frame (if any)
advanceStackFrameIter :: StackSnapshot -> WordOffset -> Maybe (StackSnapshot, WordOffset)
@@ -202,23 +210,24 @@ advanceStackFrameIter (StackSnapshot stackSnapshot#) index =
primWordToWordOffset :: Word# -> WordOffset
primWordToWordOffset w# = fromIntegral (W# w#)
-getClosure :: StackSnapshot# -> WordOffset -> WordOffset -> IO Box
-getClosure stackSnapshot# index relativeOffset =
- IO $ \s ->
- case getBoxedClosure#
- stackSnapshot#
- (wordOffsetToWord# (index + relativeOffset))
- s of
- (# s1, ptr #) ->
- (# s1, Box ptr #)
-
--- TODO: Inline later
+getClosure :: StackSnapshot# -> WordOffset -> IO Closure
+getClosure stackSnapshot# index =
+ ( IO $ \s ->
+ case getBoxedClosure#
+ stackSnapshot#
+ (wordOffsetToWord# index)
+ s of
+ (# s1, ptr #) ->
+ (# s1, Box ptr #)
+ )
+ >>= getBoxedClosureData
+
-- | Iterator state for stack decoding
-data StackFrameIter =
- -- | Represents a closure on the stack
- SfiClosure !StackSnapshot# !WordOffset
- -- | Represents a primitive word on the stack
- | SfiPrimitive !StackSnapshot# !WordOffset
+data StackFrameIter
+ = -- | Represents a closure on the stack
+ SfiClosure !StackSnapshot# !WordOffset
+ | -- | Represents a primitive word on the stack
+ SfiPrimitive !StackSnapshot# !WordOffset
decodeLargeBitmap :: LargeBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [Closure]
decodeLargeBitmap getterFun# stackSnapshot# index relativePayloadOffset = do
@@ -226,7 +235,7 @@ decodeLargeBitmap getterFun# stackSnapshot# index relativePayloadOffset = do
case getterFun# stackSnapshot# (wordOffsetToWord# index) s of
(# s1, ba#, s# #) -> (# s1, (ByteArray ba#, W# s#) #)
let bitmapWords :: [Word] = byteArrayToList bitmapArray
- decodeBitmaps stackSnapshot# index relativePayloadOffset bitmapWords size
+ decodeBitmaps stackSnapshot# (index + relativePayloadOffset) bitmapWords size
where
byteArrayToList :: ByteArray -> [Word]
byteArrayToList (ByteArray bArray) = go 0
@@ -239,16 +248,16 @@ decodeLargeBitmap getterFun# stackSnapshot# index relativePayloadOffset = do
sizeofByteArray :: ByteArray# -> Int
sizeofByteArray arr# = I# (sizeofByteArray# arr#)
-decodeBitmaps :: StackSnapshot# -> WordOffset -> WordOffset -> [Word] -> Word -> IO [Closure]
-decodeBitmaps stackSnapshot# index relativePayloadOffset bitmapWords size =
- let bes = wordsToBitmapEntries (index + relativePayloadOffset) bitmapWords size
+decodeBitmaps :: StackSnapshot# -> WordOffset -> [Word] -> Word -> IO [Closure]
+decodeBitmaps stackSnapshot# index bitmapWords size =
+ let bes = wordsToBitmapEntries index bitmapWords size
in mapM toBitmapPayload bes
where
toBitmapPayload :: StackFrameIter -> IO Closure
- toBitmapPayload (SfiPrimitive stack# i) = do
- w <- getWord stack# i 0
+ toBitmapPayload (SfiPrimitive stack# i) = do
+ w <- getWord stack# i
pure $ UnknownTypeWordSizedPrimitive w
- toBitmapPayload (SfiClosure stack# i) = getBoxedClosureData =<< getClosure stack# i 0
+ toBitmapPayload (SfiClosure stack# i) = getClosure stack# i
wordsToBitmapEntries :: WordOffset -> [Word] -> Word -> [StackFrameIter]
wordsToBitmapEntries _ [] 0 = []
@@ -261,7 +270,7 @@ decodeBitmaps stackSnapshot# index relativePayloadOffset bitmapWords size =
Just sfi' ->
entries
++ wordsToBitmapEntries
- ((getIndex sfi') + 1)
+ (getIndex sfi' + 1)
bs
subtractDecodedBitmapWord
_ -> error "This should never happen! Recursion ended not in base case."
@@ -287,6 +296,8 @@ decodeBitmaps stackSnapshot# index relativePayloadOffset bitmapWords size =
getIndex (SfiClosure _ i) = i
getIndex (SfiPrimitive _ i) = i
+-- TODO: (auto-) format the code
+-- TODO: Check all functions with two WordOffsets? Can't it be one?
decodeSmallBitmap :: SmallBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [Closure]
decodeSmallBitmap getterFun# stackSnapshot# index relativePayloadOffset =
do
@@ -294,10 +305,10 @@ decodeSmallBitmap getterFun# stackSnapshot# index relativePayloadOffset =
case getterFun# stackSnapshot# (wordOffsetToWord# index) s of
(# s1, b#, s# #) -> (# s1, (W# b#, W# s#) #)
let bitmapWords = [bitmap | size > 0]
- decodeBitmaps stackSnapshot# index relativePayloadOffset bitmapWords size
+ decodeBitmaps stackSnapshot# (index + relativePayloadOffset) bitmapWords size
-unpackStackFrame :: (StackSnapshot, WordOffset) -> IO StackFrame
-unpackStackFrame ((StackSnapshot stackSnapshot#), index) = do
+unpackStackFrame :: StackFrameLocation -> IO StackFrame
+unpackStackFrame (StackSnapshot stackSnapshot#, index) = do
info <- getInfoTableOnStack stackSnapshot# index
unpackStackFrame' info
where
@@ -305,7 +316,7 @@ unpackStackFrame ((StackSnapshot stackSnapshot#), index) = do
unpackStackFrame' info =
case tipe info of
RET_BCO -> do
- bco' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgClosurePayload
+ bco' <- getClosure stackSnapshot# (index + offsetStgClosurePayload)
-- The arguments begin directly after the payload's one element
bcoArgs' <- decodeLargeBitmap getBCOLargeBitmap# stackSnapshot# index (offsetStgClosurePayload + 1)
pure
@@ -330,8 +341,8 @@ unpackStackFrame ((StackSnapshot stackSnapshot#), index) = do
}
RET_FUN -> do
retFunType' <- getRetFunType stackSnapshot# index
- retFunSize' <- getWord stackSnapshot# index offsetStgRetFunFrameSize
- retFunFun' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgRetFunFrameFun
+ retFunSize' <- getWord stackSnapshot# (index + offsetStgRetFunFrameSize)
+ retFunFun' <- getClosure stackSnapshot# (index + offsetStgRetFunFrameFun)
retFunPayload' <-
if retFunType' == ARG_GEN_BIG
then decodeLargeBitmap getRetFunLargeBitmap# stackSnapshot# index offsetStgRetFunFramePayload
@@ -345,15 +356,15 @@ unpackStackFrame ((StackSnapshot stackSnapshot#), index) = do
retFunPayload = retFunPayload'
}
UPDATE_FRAME -> do
- updatee' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgUpdateFrameUpdatee
+ updatee' <- getClosure stackSnapshot# (index + offsetStgUpdateFrameUpdatee)
pure $
UpdateFrame
{ info_tbl = info,
updatee = updatee'
}
CATCH_FRAME -> do
- exceptions_blocked' <- getWord stackSnapshot# index offsetStgCatchFrameExceptionsBlocked
- handler' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgCatchFrameHandler
+ exceptions_blocked' <- getWord stackSnapshot# (index + offsetStgCatchFrameExceptionsBlocked)
+ handler' <- getClosure stackSnapshot# (index + offsetStgCatchFrameHandler)
pure $
CatchFrame
{ info_tbl = info,
@@ -370,8 +381,8 @@ unpackStackFrame ((StackSnapshot stackSnapshot#), index) = do
}
STOP_FRAME -> pure $ StopFrame {info_tbl = info}
ATOMICALLY_FRAME -> do
- atomicallyFrameCode' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgAtomicallyFrameCode
- result' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgAtomicallyFrameResult
+ atomicallyFrameCode' <- getClosure stackSnapshot# (index + offsetStgAtomicallyFrameCode)
+ result' <- getClosure stackSnapshot# (index + offsetStgAtomicallyFrameResult)
pure $
AtomicallyFrame
{ info_tbl = info,
@@ -379,9 +390,9 @@ unpackStackFrame ((StackSnapshot stackSnapshot#), index) = do
result = result'
}
CATCH_RETRY_FRAME -> do
- running_alt_code' <- getWord stackSnapshot# index offsetStgCatchRetryFrameRunningAltCode
- first_code' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgCatchRetryFrameRunningFirstCode
- alt_code' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgCatchRetryFrameAltCode
+ running_alt_code' <- getWord stackSnapshot# (index + offsetStgCatchRetryFrameRunningAltCode)
+ first_code' <- getClosure stackSnapshot# (index + offsetStgCatchRetryFrameRunningFirstCode)
+ alt_code' <- getClosure stackSnapshot# (index + offsetStgCatchRetryFrameAltCode)
pure $
CatchRetryFrame
{ info_tbl = info,
@@ -390,8 +401,8 @@ unpackStackFrame ((StackSnapshot stackSnapshot#), index) = do
alt_code = alt_code'
}
CATCH_STM_FRAME -> do
- catchFrameCode' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgCatchSTMFrameCode
- handler' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgCatchSTMFrameHandler
+ catchFrameCode' <- getClosure stackSnapshot# (index + offsetStgCatchSTMFrameCode)
+ handler' <- getClosure stackSnapshot# (index + offsetStgCatchSTMFrameHandler)
pure $
CatchStmFrame
{ info_tbl = info,
@@ -400,25 +411,27 @@ unpackStackFrame ((StackSnapshot stackSnapshot#), index) = do
}
x -> error $ "Unexpected closure type on stack: " ++ show x
-getClosureDataFromHeapObject
- :: a
- -- ^ Heap object to decode.
- -> IO Closure
- -- ^ Heap representation of the closure.
+-- TODO: Duplicate
+getClosureDataFromHeapObject ::
+ -- | Heap object to decode.
+ a ->
+ -- | Heap representation of the closure.
+ IO Closure
getClosureDataFromHeapObject x = do
- case unpackClosure# x of
- (# infoTableAddr, heapRep, pointersArray #) -> do
- let infoTablePtr = Ptr infoTableAddr
- ptrList = [case indexArray# pointersArray i of
- (# ptr #) -> Box ptr
- | I# i <- [0..I# (sizeofArray# pointersArray) - 1]
- ]
-
- infoTable <- peekItbl infoTablePtr
- case tipe infoTable of
- TSO -> pure $ UnsupportedClosure infoTable
- STACK -> pure $ UnsupportedClosure infoTable
- _ -> getClosureDataFromHeapRep heapRep infoTablePtr ptrList
+ case unpackClosure# x of
+ (# infoTableAddr, heapRep, pointersArray #) -> do
+ let infoTablePtr = Ptr infoTableAddr
+ ptrList =
+ [ case indexArray# pointersArray i of
+ (# ptr #) -> Box ptr
+ | I# i <- [0 .. I# (sizeofArray# pointersArray) - 1]
+ ]
+
+ infoTable <- peekItbl infoTablePtr
+ case tipe infoTable of
+ TSO -> pure $ UnsupportedClosure infoTable
+ STACK -> pure $ UnsupportedClosure infoTable
+ _ -> getClosureDataFromHeapRep heapRep infoTablePtr ptrList
-- | Like 'getClosureData', but taking a 'Box', so it is easier to work with.
getBoxedClosureData :: Box -> IO Closure
@@ -435,21 +448,18 @@ intToWord# i = int2Word# (toInt# i)
wordOffsetToWord# :: WordOffset -> Word#
wordOffsetToWord# wo = intToWord# (fromIntegral wo)
--- | Decode `StackSnapshot` to a Closure
+type StackFrameLocation = (StackSnapshot, WordOffset)
+
+-- | Decode `StackSnapshot` to a `StgStackClosure`
--
--- Due to the use of `Box` this decoding is lazy. The first decoded closure is
--- the representation of the @StgStack@ itself.
+-- The return value is the representation of the @StgStack@ itself.
decodeStack :: StackSnapshot -> IO StgStackClosure
-decodeStack (StackSnapshot stack#) =
- unpackStack stack#
-
-unpackStack :: StackSnapshot# -> IO StgStackClosure
-unpackStack stack# = do
+decodeStack (StackSnapshot stack#) = do
info <- getInfoTableForStack stack#
(stack_size', stack_dirty', stack_marking') <- getStackFields stack#
case tipe info of
STACK -> do
- let sfis = decodeStackToBoxes (StackSnapshot stack#)
+ let sfis = stackFrameLocations (StackSnapshot stack#)
stack' <- mapM unpackStackFrame sfis
pure $
StgStackClosure
@@ -461,15 +471,16 @@ unpackStack stack# = do
}
_ -> error $ "Expected STACK closure, got " ++ show info
where
- decodeStackToBoxes :: StackSnapshot -> [(StackSnapshot, WordOffset)]
- decodeStackToBoxes s =
- (stackHead s)
- : go (advanceStackFrameIter (fst (stackHead s)) (snd (stackHead s)))
+ stackFrameLocations :: StackSnapshot -> [StackFrameLocation]
+ stackFrameLocations s =
+ stackHead s
+ : go (uncurry advanceStackFrameIter (stackHead s))
where
- go :: Maybe (StackSnapshot, WordOffset) -> [(StackSnapshot, WordOffset)]
+ go :: Maybe StackFrameLocation -> [StackFrameLocation]
go Nothing = []
- go (Just r) = r : go (advanceStackFrameIter (fst r) (snd r))
+ go (Just r) = r : go (uncurry advanceStackFrameIter r)
#else
module GHC.Exts.Stack.Decode where
+import GHC.Base (IO)
#endif
=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -114,10 +114,10 @@ getRetFunLargeBitmapzh(P_ stack, W_ offsetWords) {
return (stgArrBytes, size);
}
-// getWordzh(StgStack* stack, StgWord offsetWords, StgWord offsetBytes)
-getWordzh(P_ stack, W_ offsetWords, W_ offsetBytes) {
+// getWordzh(StgStack* stack, StgWord offsetWords)
+getWordzh(P_ stack, W_ offsetWords) {
P_ wordAddr;
- wordAddr = (StgStack_sp(stack) + WDS(offsetWords) + WDS(offsetBytes));
+ wordAddr = (StgStack_sp(stack) + WDS(offsetWords));
return (W_[wordAddr]);
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c2bbf8f83d6d82c66746d3de47266e92408c2fc...bb6ea826ac0d7d543623e8b98a74b6f266b5b512
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c2bbf8f83d6d82c66746d3de47266e92408c2fc...bb6ea826ac0d7d543623e8b98a74b6f266b5b512
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230409/87362460/attachment-0001.html>
More information about the ghc-commits
mailing list