[Git][ghc/ghc][wip/decode_cloned_stack] 5 commits: More on boxes: Increase lazy-ness
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Tue Jan 24 19:36:29 UTC 2023
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
6dcf6fa8 by Sven Tennie at 2023-01-24T18:31:21+00:00
More on boxes: Increase lazy-ness
- - - - -
c3e2b7b7 by Sven Tennie at 2023-01-24T18:34:18+00:00
Formatting
- - - - -
eac21df7 by Sven Tennie at 2023-01-24T18:38:40+00:00
Bang patterns not necessary
The records already have bangs
- - - - -
58c31d8f by Sven Tennie at 2023-01-24T19:05:44+00:00
Formatting
- - - - -
fc7e050b by Sven Tennie at 2023-01-24T19:08:01+00:00
Remove unnecessary module qualifier
- - - - -
11 changed files:
- libraries/ghc-heap/GHC/Exts/DecodeStack.hs
- libraries/ghc-heap/GHC/Exts/Heap.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/tests/TestUtils.hs
- libraries/ghc-heap/tests/all.T
- libraries/ghc-heap/tests/stack_big_ret.hs
- − libraries/ghc-heap/tests/stack_lib.c
- libraries/ghc-heap/tests/stack_misc_closures.hs
- libraries/ghc-heap/tests/stack_stm_frames.hs
- libraries/ghc-heap/tests/stack_underflow.hs
- libraries/ghci/GHCi/Run.hs
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/DecodeStack.hs
=====================================
@@ -1,40 +1,40 @@
{-# LANGUAGE CPP #-}
#if MIN_TOOL_VERSION_ghc(9,5,0)
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE RecordWildCards #-}
-- TODO: Find better place than top level. Re-export from top-level?
-module GHC.Exts.DecodeStack (
- decodeStack,
- decodeStack'
- ) where
+module GHC.Exts.DecodeStack
+ ( decodeStack,
+ )
+where
-import GHC.Exts.StackConstants
-import GHC.Exts.Heap.Constants (wORD_SIZE_IN_BITS)
-import Data.Maybe
import Data.Bits
-import Foreign
-import Prelude
-import GHC.Stack.CloneStack
+import Data.Maybe
-- TODO: Remove before releasing
import Debug.Trace
+import Foreign
import GHC.Exts
-import GHC.Exts.Heap.Closures as CL
-import GHC.Exts.Heap.ClosureTypes
import GHC.Exts.DecodeHeap
+import GHC.Exts.Heap.ClosureTypes
+import GHC.Exts.Heap.Closures
+import GHC.Exts.Heap.Constants (wORD_SIZE_IN_BITS)
import GHC.Exts.Heap.InfoTable
+import GHC.Exts.StackConstants
+import GHC.Stack.CloneStack
+import Prelude
foreign import prim "derefStackWordzh" derefStackWord# :: StackSnapshot# -> Word# -> Word#
@@ -57,7 +57,7 @@ foreign import prim "getUnderflowFrameNextChunkzh" getUnderflowFrameNextChunk# :
getUnderflowFrameNextChunk :: StackFrameIter -> StackSnapshot
getUnderflowFrameNextChunk (StackFrameIter {..}) = StackSnapshot s#
where
- s# = getUnderflowFrameNextChunk# stackSnapshot# (wordOffsetToWord# index)
+ s# = getUnderflowFrameNextChunk# stackSnapshot# (wordOffsetToWord# index)
foreign import prim "getWordzh" getWord# :: StackSnapshot# -> Word# -> Word# -> Word#
@@ -82,28 +82,29 @@ foreign import prim "getSmallBitmapzh" getSmallBitmap# :: StackSnapshot# -> Word
foreign import prim "getRetSmallSpecialTypezh" getRetSmallSpecialType# :: StackSnapshot# -> Word# -> Word#
getRetSmallSpecialType :: StackFrameIter -> SpecialRetSmall
-getRetSmallSpecialType (StackFrameIter {..}) = let special# = getRetSmallSpecialType# stackSnapshot# (wordOffsetToWord# index)
- in
- (toEnum . fromInteger . toInteger) (W# special#)
+getRetSmallSpecialType (StackFrameIter {..}) =
+ let special# = getRetSmallSpecialType# stackSnapshot# (wordOffsetToWord# index)
+ in (toEnum . fromInteger . toInteger) (W# special#)
foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: StackSnapshot# -> Word# -> (# Word#, Word# #)
foreign import prim "advanceStackFrameIterzh" advanceStackFrameIter# :: StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #)
-foreign import prim "getInfoTableAddrzh" getInfoTableAddr# :: StackSnapshot# -> Word# -> Addr#
+foreign import prim "getInfoTableAddrzh" getInfoTableAddr# :: StackSnapshot# -> Word# -> Addr#
getInfoTable :: StackFrameIter -> IO StgInfoTable
-getInfoTable StackFrameIter {..} =
+getInfoTable StackFrameIter {..} =
let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index))
- in peekItbl infoTablePtr
+ in peekItbl infoTablePtr
+
+data StackFrameIter = StackFrameIter
+ { stackSnapshot# :: StackSnapshot#,
+ index :: WordOffset
+ }
-data StackFrameIter = StackFrameIter {
- stackSnapshot# :: StackSnapshot#,
- index :: WordOffset
- }
-- TODO: Remove this instance (debug only)
instance Show StackFrameIter where
- show (StackFrameIter { .. }) = "StackFrameIter " ++ "(StackSnapshot _" ++ " " ++ show index
+ show (StackFrameIter {..}) = "StackFrameIter " ++ "(StackSnapshot _" ++ " " ++ show index
-- | Get an interator starting with the top-most stack frame
stackHead :: StackSnapshot -> StackFrameIter
@@ -111,141 +112,165 @@ stackHead (StackSnapshot s) = StackFrameIter s 0 -- GHC stacks are never empty
-- | Advance iterator to the next stack frame (if any)
advanceStackFrameIter :: StackFrameIter -> Maybe StackFrameIter
-advanceStackFrameIter (StackFrameIter {..}) = let !(# s', i', hasNext #) = advanceStackFrameIter# stackSnapshot# (wordOffsetToWord# index) in
- if (I# hasNext) > 0 then Just $ StackFrameIter s' (primWordToWordOffset i')
- else Nothing
+advanceStackFrameIter (StackFrameIter {..}) =
+ let !(# s', i', hasNext #) = advanceStackFrameIter# stackSnapshot# (wordOffsetToWord# index)
+ in if (I# hasNext) > 0
+ then Just $ StackFrameIter s' (primWordToWordOffset i')
+ else Nothing
primWordToWordOffset :: Word# -> WordOffset
primWordToWordOffset w# = fromIntegral (W# w#)
-data BitmapEntry = BitmapEntry {
- closureFrame :: StackFrameIter,
+data BitmapEntry = BitmapEntry
+ { closureFrame :: StackFrameIter,
isPrimitive :: Bool
- } deriving (Show)
+ }
+ deriving (Show)
wordsToBitmapEntries :: StackFrameIter -> [Word] -> Word -> [BitmapEntry]
wordsToBitmapEntries _ [] 0 = []
wordsToBitmapEntries _ [] i = error $ "Invalid state: Empty list, size " ++ show i
wordsToBitmapEntries _ l 0 = error $ "Invalid state: Size 0, list " ++ show l
-wordsToBitmapEntries sfi (b:bs) bitmapSize =
- let entries = toBitmapEntries sfi b (min bitmapSize (fromIntegral wORD_SIZE_IN_BITS))
- mbLastEntry = (listToMaybe . reverse) entries
- mbLastFrame = fmap closureFrame mbLastEntry
- in
- case mbLastFrame of
- Just (StackFrameIter {..} ) ->
- entries ++ wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + 1)) bs (subtractDecodedBitmapWord bitmapSize)
- Nothing -> error "This should never happen! Recursion ended not in base case."
+wordsToBitmapEntries sfi (b : bs) bitmapSize =
+ let entries = toBitmapEntries sfi b (min bitmapSize (fromIntegral wORD_SIZE_IN_BITS))
+ mbLastEntry = (listToMaybe . reverse) entries
+ mbLastFrame = fmap closureFrame mbLastEntry
+ in case mbLastFrame of
+ Just (StackFrameIter {..}) ->
+ entries ++ wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + 1)) bs (subtractDecodedBitmapWord bitmapSize)
+ Nothing -> error "This should never happen! Recursion ended not in base case."
where
subtractDecodedBitmapWord :: Word -> Word
subtractDecodedBitmapWord bSize = fromIntegral $ max 0 ((fromIntegral bSize) - wORD_SIZE_IN_BITS)
toBitmapEntries :: StackFrameIter -> Word -> Word -> [BitmapEntry]
toBitmapEntries _ _ 0 = []
-toBitmapEntries sfi@(StackFrameIter {..}) bitmapWord bSize = BitmapEntry {
- closureFrame = sfi,
- isPrimitive = (bitmapWord .&. 1) /= 0
- } : toBitmapEntries (StackFrameIter stackSnapshot# (index + 1)) (bitmapWord `shiftR` 1) (bSize - 1)
+toBitmapEntries sfi@(StackFrameIter {..}) bitmapWord bSize =
+ BitmapEntry
+ { closureFrame = sfi,
+ isPrimitive = (bitmapWord .&. 1) /= 0
+ }
+ : toBitmapEntries (StackFrameIter stackSnapshot# (index + 1)) (bitmapWord `shiftR` 1) (bSize - 1)
toBitmapPayload :: BitmapEntry -> Box
-toBitmapPayload e | isPrimitive e = DecodedClosureBox $ (CL.UnknownTypeWordSizedPrimitive . derefStackWord . closureFrame) e
+toBitmapPayload e
+ | isPrimitive e =
+ let !b = (UnknownTypeWordSizedPrimitive . derefStackWord . closureFrame) e
+ in DecodedBox b
toBitmapPayload e = getClosure (closureFrame e) 0
-getClosure :: StackFrameIter -> WordOffset-> Box
+getClosure :: StackFrameIter -> WordOffset -> Box
getClosure StackFrameIter {..} relativeOffset =
+ -- TODO: What happens if the GC kicks in here?
let offset = wordOffsetToWord# (index + relativeOffset)
!ptr = (getAddr# stackSnapshot# offset)
!a :: Any = unsafeCoerce# ptr
- in Box a
+ in Box a
decodeLargeBitmap :: (StackSnapshot# -> Word# -> (# ByteArray#, Word# #)) -> StackFrameIter -> WordOffset -> [Box]
decodeLargeBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset =
- let !(# bitmapArray#, size# #) = getterFun# stackSnapshot# (wordOffsetToWord# index)
- bitmapWords :: [Word] = byteArrayToList bitmapArray#
- in
- decodeBitmaps sfi relativePayloadOffset bitmapWords (W# size#)
+ let !(# bitmapArray#, size# #) = getterFun# stackSnapshot# (wordOffsetToWord# index)
+ bitmapWords :: [Word] = byteArrayToList bitmapArray#
+ in decodeBitmaps sfi relativePayloadOffset bitmapWords (W# size#)
decodeBitmaps :: StackFrameIter -> WordOffset -> [Word] -> Word -> [Box]
decodeBitmaps (StackFrameIter {..}) relativePayloadOffset bitmapWords size =
- let
- bes = wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + relativePayloadOffset)) bitmapWords size
- in
- map toBitmapPayload bes
+ let bes = wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + relativePayloadOffset)) bitmapWords size
+ in map toBitmapPayload bes
decodeSmallBitmap :: (StackSnapshot# -> Word# -> (# Word#, Word# #)) -> StackFrameIter -> WordOffset -> [Box]
decodeSmallBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset =
- let !(# bitmap#, size# #) = getterFun# stackSnapshot# (wordOffsetToWord# index)
- size = W# size#
- bitmapWords = if size > 0 then [(W# bitmap#)] else []
- in
- decodeBitmaps sfi relativePayloadOffset bitmapWords size
+ let !(# bitmap#, size# #) = getterFun# stackSnapshot# (wordOffsetToWord# index)
+ size = W# size#
+ bitmapWords = if size > 0 then [(W# bitmap#)] else []
+ in decodeBitmaps sfi relativePayloadOffset bitmapWords size
byteArrayToList :: ByteArray# -> [Word]
byteArrayToList bArray = go 0
where
go i
- | i < maxIndex = (W# (indexWordArray# bArray (toInt# i))) : (go (i + 1))
+ | i < maxIndex = (W# (indexWordArray# bArray (toInt# i))) : (go (i + 1))
| otherwise = []
maxIndex = sizeofByteArray bArray `quot` sizeOf (undefined :: Word)
wordOffsetToWord# :: WordOffset -> Word#
wordOffsetToWord# wo = intToWord# (fromIntegral wo)
-unpackStackFrameIter :: StackFrameIter -> IO CL.Closure
+unpackStackFrameIter :: StackFrameIter -> IO Box
unpackStackFrameIter sfi = do
info <- getInfoTable sfi
- pure $ unpackStackFrameIter' info
+ let c = unpackStackFrameIter' info
+ pure $ DecodedBox c
where
- -- TODO: Check all (missing?) bang patterns
- unpackStackFrameIter' :: StgInfoTable -> CL.Closure
- unpackStackFrameIter' info = do
+ unpackStackFrameIter' :: StgInfoTable -> Closure
+ unpackStackFrameIter' info =
case tipe info of
- RET_BCO -> do
- let !bco' = getClosure sfi offsetStgClosurePayload
- -- The arguments begin directly after the payload's one element
- !args' = decodeLargeBitmap getBCOLargeBitmap# sfi (offsetStgClosurePayload + 1)
- CL.RetBCO info bco' args'
- RET_SMALL -> do
- let !special = getRetSmallSpecialType sfi
- !payloads = decodeSmallBitmap getSmallBitmap# sfi offsetStgClosurePayload
- CL.RetSmall info special payloads
- RET_BIG -> CL.RetBig info $ decodeLargeBitmap getLargeBitmap# sfi offsetStgClosurePayload
- RET_FUN -> do
- let t = getRetFunType sfi
- size' = getWord sfi offsetStgRetFunFrameSize
- fun' = getClosure sfi offsetStgRetFunFrameFun
- payload' =
- if t == CL.ARG_GEN_BIG then
- decodeLargeBitmap getRetFunLargeBitmap# sfi offsetStgRetFunFramePayload
- else
- decodeSmallBitmap getRetFunSmallBitmap# sfi offsetStgRetFunFramePayload
- CL.RetFun info t size' fun' payload'
- -- TODO: Decode update frame type
- UPDATE_FRAME -> let
- !t = getUpdateFrameType sfi
- c = getClosure sfi offsetStgUpdateFrameUpdatee
- in
- CL.UpdateFrame info t c
- CATCH_FRAME -> do
- let exceptionsBlocked = getWord sfi offsetStgCatchFrameExceptionsBlocked
- c = getClosure sfi offsetStgCatchFrameHandler
- CL.CatchFrame info exceptionsBlocked c
- UNDERFLOW_FRAME -> let
+ RET_BCO ->
+ RetBCO
+ { info = info,
+ bco = getClosure sfi offsetStgClosurePayload,
+ -- The arguments begin directly after the payload's one element
+ bcoArgs = decodeLargeBitmap getBCOLargeBitmap# sfi (offsetStgClosurePayload + 1)
+ }
+ RET_SMALL ->
+ RetSmall
+ { info = info,
+ knownRetSmallType = getRetSmallSpecialType sfi,
+ payload = decodeSmallBitmap getSmallBitmap# sfi offsetStgClosurePayload
+ }
+ RET_BIG ->
+ RetBig
+ { info = info,
+ payload = decodeLargeBitmap getLargeBitmap# sfi offsetStgClosurePayload
+ }
+ RET_FUN ->
+ RetFun
+ { info = info,
+ retFunType = getRetFunType sfi,
+ retFunSize = getWord sfi offsetStgRetFunFrameSize,
+ retFunFun = getClosure sfi offsetStgRetFunFrameFun,
+ retFunPayload =
+ if getRetFunType sfi == ARG_GEN_BIG
+ then decodeLargeBitmap getRetFunLargeBitmap# sfi offsetStgRetFunFramePayload
+ else decodeSmallBitmap getRetFunSmallBitmap# sfi offsetStgRetFunFramePayload
+ }
+ UPDATE_FRAME ->
+ UpdateFrame
+ { info = info,
+ knownUpdateFrameType = getUpdateFrameType sfi,
+ updatee = getClosure sfi offsetStgUpdateFrameUpdatee
+ }
+ CATCH_FRAME ->
+ CatchFrame
+ { info = info,
+ exceptions_blocked = getWord sfi offsetStgCatchFrameExceptionsBlocked,
+ handler = getClosure sfi offsetStgCatchFrameHandler
+ }
+ UNDERFLOW_FRAME ->
+ UnderflowFrame
+ { info = info,
nextChunk = getUnderflowFrameNextChunk sfi
- in
- CL.UnderflowFrame info nextChunk
- STOP_FRAME -> CL.StopFrame info
- ATOMICALLY_FRAME -> CL.AtomicallyFrame info
- (getClosure sfi offsetStgAtomicallyFrameCode)
- (getClosure sfi offsetStgAtomicallyFrameResult)
- CATCH_RETRY_FRAME -> do
- let running_alt_code' = getWord sfi offsetStgCatchRetryFrameRunningAltCode
- first_code' = getClosure sfi offsetStgCatchRetryFrameRunningFirstCode
- alt_code' = getClosure sfi offsetStgCatchRetryFrameAltCode
- CL.CatchRetryFrame info running_alt_code' first_code' alt_code'
- CATCH_STM_FRAME -> CL.CatchStmFrame info
- (getClosure sfi offsetStgCatchSTMFrameCode)
- (getClosure sfi offsetStgCatchSTMFrameHandler)
+ }
+ STOP_FRAME -> StopFrame {info = info}
+ ATOMICALLY_FRAME ->
+ AtomicallyFrame
+ { info = info,
+ atomicallyFrameCode = getClosure sfi offsetStgAtomicallyFrameCode,
+ result = getClosure sfi offsetStgAtomicallyFrameResult
+ }
+ CATCH_RETRY_FRAME ->
+ CatchRetryFrame
+ { info = info,
+ running_alt_code = getWord sfi offsetStgCatchRetryFrameRunningAltCode,
+ first_code = getClosure sfi offsetStgCatchRetryFrameRunningFirstCode,
+ alt_code = getClosure sfi offsetStgCatchRetryFrameAltCode
+ }
+ CATCH_STM_FRAME ->
+ CatchStmFrame
+ { info = info,
+ catchFrameCode = getClosure sfi offsetStgCatchSTMFrameCode,
+ handler = getClosure sfi offsetStgCatchSTMFrameHandler
+ }
x -> error $ "Unexpected closure type on stack: " ++ show x
-- | Size of the byte array in bytes.
@@ -261,19 +286,17 @@ toInt# (I# i) = i
intToWord# :: Int -> Word#
intToWord# i = int2Word# (toInt# i)
-decodeStack :: StackSnapshot -> IO CL.Closure
+decodeStack :: StackSnapshot -> IO Closure
decodeStack s = do
stack <- decodeStack' s
- let boxed = map DecodedClosureBox stack
- pure $ SimpleStack boxed
+ pure $ SimpleStack stack
-decodeStack' :: StackSnapshot -> IO [CL.Closure]
+decodeStack' :: StackSnapshot -> IO [Box]
decodeStack' s = unpackStackFrameIter (stackHead s) >>= \frame -> (frame :) <$> go (advanceStackFrameIter (stackHead s))
where
- go :: Maybe StackFrameIter -> IO [CL.Closure]
+ go :: Maybe StackFrameIter -> IO [Box]
go Nothing = pure []
go (Just sfi) = (trace "decode\n" (unpackStackFrameIter sfi)) >>= \frame -> (frame :) <$> go (advanceStackFrameIter sfi)
-
#else
module GHC.Exts.DecodeStack where
#endif
=====================================
libraries/ghc-heap/GHC/Exts/Heap.hs
=====================================
@@ -161,6 +161,7 @@ getClosureDataFromHeapObject x = do
(# infoTableAddr, heapRep, pointersArray #) -> do
let infoTablePtr = Ptr infoTableAddr
ptrList = [case indexArray# pointersArray i of
+-- TODO: What happens if the GC kicks in here? Is that possible? check Cmm.
(# ptr #) -> Box ptr
| I# i <- [0..I# (sizeofArray# pointersArray) - 1]
]
@@ -175,5 +176,5 @@ getClosureDataFromHeapObject x = do
getBoxedClosureData :: Box -> IO Closure
getBoxedClosureData (Box a) = getClosureData a
#if MIN_TOOL_VERSION_ghc(9,5,0)
-getBoxedClosureData (DecodedClosureBox a) = pure a
+getBoxedClosureData (DecodedBox a) = pure a
#endif
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -53,6 +53,7 @@ import Numeric
#if MIN_VERSION_base(4,17,0)
import GHC.Stack.CloneStack (StackSnapshot(..))
+import Unsafe.Coerce (unsafeCoerce)
#endif
------------------------------------------------------------------------
@@ -68,13 +69,14 @@ foreign import prim "reallyUnsafePtrEqualityUpToTag"
-- required, e.g. in 'getBoxedClosureData', the function knows how far it has
-- to evaluate the argument.
#if MIN_VERSION_base(4,17,0)
-data Box = Box Any | DecodedClosureBox Closure
+data Box = Box Any | DecodedBox Closure
#else
data Box = Box Any
#endif
+-- TODO: Handle PrimitiveWordHolder
instance Show Box where
-- From libraries/base/GHC/Ptr.lhs
showsPrec _ (Box a) rs =
@@ -86,19 +88,21 @@ instance Show Box where
addr = ptr - tag
pad_out ls = '0':'x':ls
#if MIN_VERSION_base(4,17,0)
- showsPrec _ (DecodedClosureBox a) rs = "(DecodedClosureBox " ++ show a ++ ")" ++ rs
+ showsPrec _ (DecodedBox a) rs = "(DecodedBox " ++ show a ++ ")" ++ rs
#endif
-- | Boxes can be compared, but this is not pure, as different heap objects can,
-- after garbage collection, become the same object.
+-- TODO: Handle PrimitiveWordHolder
areBoxesEqual :: Box -> Box -> IO Bool
areBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of
0# -> pure False
_ -> pure True
#if MIN_VERSION_base(4,17,0)
--- TODO: Implement
-areBoxesEqual (DecodedClosureBox _) (DecodedClosureBox _) = error "Not implemented, yet!"
-areBoxesEqual _ _ = pure $ False
+areBoxesEqual (DecodedBox a) (DecodedBox b) = areBoxesEqual
+ (Box (unsafeCoerce a))
+ (Box (unsafeCoerce b))
+areBoxesEqual _ _ = pure False
#endif
-- |This takes an arbitrary value and puts it into a box.
@@ -329,7 +333,6 @@ data GenClosure b
| SimpleStack {
stackClosures :: ![b]
}
- -- TODO: Add `info :: !StgInfoTable` fields
| UpdateFrame
{ info :: !StgInfoTable
, knownUpdateFrameType :: !UpdateFrameType
@@ -600,10 +603,6 @@ allClosures _ = []
-- Includes header and payload. Does not follow pointers.
--
-- @since 8.10.1
+-- TODO: Handle PrimitiveWordHolder
closureSize :: Box -> Int
closureSize (Box x) = I# (closureSize# x)
-#if MIN_VERSION_base(4,17,0)
--- TODO: Add comment to explain. This is a bit weird because it returns the size
--- of the representation, not the closure itself.
-closureSize (DecodedClosureBox dc) = closureSize $ asBox dc
-#endif
=====================================
libraries/ghc-heap/tests/TestUtils.hs
=====================================
@@ -9,11 +9,15 @@ module TestUtils
( assertEqual,
assertThat,
assertStackInvariants,
+ getDecodedStack,
unbox,
)
where
+import Control.Monad.IO.Class
import Data.Array.Byte
+import Data.Foldable
+import Debug.Trace
import GHC.Exts
import GHC.Exts.DecodeStack
import GHC.Exts.Heap
@@ -22,9 +26,13 @@ import GHC.Records
import GHC.Stack (HasCallStack)
import GHC.Stack.CloneStack
import Unsafe.Coerce (unsafeCoerce)
-import Debug.Trace
-import Data.Foldable
-import Control.Monad.IO.Class
+
+getDecodedStack :: IO (StackSnapshot, [Closure])
+getDecodedStack = do
+ s <- cloneMyStack
+ (SimpleStack cs) <- decodeStack s
+ unboxedCs <- mapM getBoxedClosureData cs
+ pure (s, unboxedCs)
assertEqual :: (HasCallStack, Monad m, Show a, Eq a) => a -> a -> m ()
assertEqual a b
@@ -43,141 +51,6 @@ assertStackInvariants stack decodedStack = do
_ -> False
)
(last decodedStack)
- ts1 <- liftIO $ toClosureTypes decodedStack
- ts2 <- liftIO $ toClosureTypes stack
- assertEqual ts1 ts2
-
-class ToClosureTypes a where
- toClosureTypes :: a -> IO [ClosureType]
-
-instance ToClosureTypes StackSnapshot where
- toClosureTypes = pure . stackSnapshotToClosureTypes . foldStackToArrayClosure
-
-instance ToClosureTypes Closure where
- toClosureTypes = stackFrameToClosureTypes
-
-instance ToClosureTypes a => ToClosureTypes [a] where
- toClosureTypes cs = concat <$> mapM toClosureTypes cs
-
-foreign import ccall "foldStackToArrayClosure" foldStackToArrayClosure# :: StackSnapshot# -> ByteArray#
-
-foldStackToArrayClosure :: StackSnapshot -> ByteArray
-foldStackToArrayClosure (StackSnapshot s#) = ByteArray (foldStackToArrayClosure# s#)
-
-foreign import ccall "bytesInWord" bytesInWord# :: Word
-
-stackSnapshotToClosureTypes :: ByteArray -> [ClosureType]
-stackSnapshotToClosureTypes = wordsToClosureTypes . toWords
- where
- toWords :: ByteArray -> [Word]
- toWords ba@(ByteArray b#) =
- let s = I# (sizeofByteArray# b#)
- in [W# (indexWordArray# b# (toInt# i)) | i <- [0 .. maxWordIndex (ba)]]
- where
- maxWordIndex :: ByteArray -> Int
- maxWordIndex (ByteArray ba#) =
- let s = I# (sizeofByteArray# ba#)
- words = s `div` fromIntegral bytesInWord#
- in case words of
- w | w == 0 -> error "ByteArray contains no content!"
- w -> w - 1
-
- wordsToClosureTypes :: [Word] -> [ClosureType]
- wordsToClosureTypes = map (toEnum . fromIntegral)
-
-toInt# :: Int -> Int#
-toInt# (I# i#) = i#
-
--- TODO: Can probably be simplified once all stack closures have into tables attached.
-stackFrameToClosureTypes :: Closure -> IO [ClosureType]
-stackFrameToClosureTypes = getClosureTypes
- where
- getClosureTypes :: Closure -> IO [ClosureType]
- -- Stack frame closures
- getClosureTypes (UpdateFrame {info, updatee, ..}) = do
- u <- unbox updatee
- ts <- getClosureTypes u
- pure $ tipe info : ts
- getClosureTypes (CatchFrame {info, handler, ..}) = do
- h <- unbox handler
- ts <- getClosureTypes h
- pure $ tipe info : ts
- getClosureTypes (CatchStmFrame {info, catchFrameCode, handler}) = do
- c <- unbox catchFrameCode
- h <- unbox handler
- ts1 <- getClosureTypes c
- ts2 <- getClosureTypes h
- pure $ tipe info : ts1 ++ ts2
- getClosureTypes (CatchRetryFrame {info, first_code, alt_code, ..}) = do
- a <- unbox alt_code
- f <- unbox first_code
- ts1 <- getClosureTypes f
- ts2 <- getClosureTypes a
- pure $ tipe info : ts1 ++ ts2
- getClosureTypes (AtomicallyFrame {info, atomicallyFrameCode, result}) = do
- r <- unbox result
- a <- unbox atomicallyFrameCode
- ts1 <- getClosureTypes a
- ts2 <- getClosureTypes r
- pure $ tipe info : ts1 ++ ts2
- getClosureTypes (UnderflowFrame {..}) = pure [tipe info]
- getClosureTypes (StopFrame info) = pure [tipe info]
- getClosureTypes (RetSmall {info, payload, ..}) = do
- ts <- getBitmapClosureTypes payload
- pure $ tipe info : ts
- getClosureTypes (RetBig {info, payload}) = do
- ts <- getBitmapClosureTypes payload
- pure $ tipe info : ts
- getClosureTypes (RetFun {info, retFunFun, retFunPayload, ..}) = do
- rf <- unbox retFunFun
- ts1 <- getClosureTypes rf
- ts2 <- getBitmapClosureTypes retFunPayload
- pure $ tipe info : ts1 ++ ts2
- getClosureTypes (RetBCO {info, bco, bcoArgs, ..}) = do
- bco <- unbox bco
- bcoCls <- getClosureTypes bco
- bcoArgsCls <- getBitmapClosureTypes bcoArgs
- pure $ tipe info : bcoCls ++ bcoArgsCls
- -- Other closures
- getClosureTypes (ConstrClosure {info, ..}) = pure [tipe info]
- getClosureTypes (FunClosure {info, ..}) = pure [tipe info]
- getClosureTypes (ThunkClosure {info, ..}) = pure [tipe info]
- getClosureTypes (SelectorClosure {info, ..}) = pure [tipe info]
- getClosureTypes (PAPClosure {info, ..}) = pure [tipe info]
- getClosureTypes (APClosure {info, ..}) = pure [tipe info]
- getClosureTypes (APStackClosure {info, ..}) = pure [tipe info]
- getClosureTypes (IndClosure {info, ..}) = pure [tipe info]
- getClosureTypes (BCOClosure {info, ..}) = pure [tipe info]
- getClosureTypes (BlackholeClosure {info, ..}) = pure [tipe info]
- getClosureTypes (ArrWordsClosure {info, ..}) = pure [tipe info]
- getClosureTypes (MutArrClosure {info, ..}) = pure [tipe info]
- getClosureTypes (SmallMutArrClosure {info, ..}) = pure [tipe info]
- getClosureTypes (MVarClosure {info, ..}) = pure [tipe info]
- getClosureTypes (IOPortClosure {info, ..}) = pure [tipe info]
- getClosureTypes (MutVarClosure {info, ..}) = pure [tipe info]
- getClosureTypes (BlockingQueueClosure {info, ..}) = pure [tipe info]
- getClosureTypes (WeakClosure {info, ..}) = pure [tipe info]
- getClosureTypes (TSOClosure {info, ..}) = pure [tipe info]
- getClosureTypes (StackClosure {info, ..}) = pure [tipe info]
- getClosureTypes (OtherClosure {info, ..}) = pure [tipe info]
- getClosureTypes (UnsupportedClosure {info, ..}) = pure [tipe info]
- getClosureTypes _ = pure []
-
- getBitmapClosureTypes :: [Box] -> IO [ClosureType]
- getBitmapClosureTypes bps =
- reverse <$>
- foldlM
- ( \acc p -> do
- c <- unbox p
- case c of
- UnknownTypeWordSizedPrimitive _ -> pure acc
- c -> do
- cls <- getClosureTypes c
- pure $ cls ++ acc
- )
- []
- bps
unbox :: Box -> IO Closure
-unbox (DecodedClosureBox c) = pure c
-unbox box = getBoxedClosureData box
+unbox = getBoxedClosureData
=====================================
libraries/ghc-heap/tests/all.T
=====================================
@@ -60,40 +60,40 @@ test('T21622',
# TODO: Remove debug flags
test('stack_big_ret',
[
- extra_files(['stack_lib.c', 'TestUtils.hs']),
+ extra_files(['TestUtils.hs']),
ignore_stdout,
ignore_stderr
],
- multi_compile_and_run,
- ['stack_big_ret', [('stack_lib.c','')], '-debug -optc-g -g'])
+ compile_and_run,
+ ['-debug -optc-g -g'])
# TODO: Remove debug flags
# Options:
# - `-kc512B -kb64B`: Make stack chunk size small to provoke underflow stack frames.
test('stack_underflow',
[
- extra_files(['stack_lib.c', 'TestUtils.hs']),
+ extra_files(['TestUtils.hs']),
extra_run_opts('+RTS -kc512B -kb64B -RTS'),
ignore_stdout,
ignore_stderr
],
- multi_compile_and_run,
- ['stack_underflow', [('stack_lib.c','')], '-debug -optc-g -g'])
+ compile_and_run,
+ ['-debug -optc-g -g'])
# TODO: Remove debug flags
test('stack_stm_frames',
[
- extra_files(['stack_lib.c', 'TestUtils.hs']),
+ extra_files(['TestUtils.hs']),
ignore_stdout,
ignore_stderr
],
- multi_compile_and_run,
- ['stack_stm_frames', [('stack_lib.c','')], '-debug -optc-g -g'])
+ compile_and_run,
+ ['-debug -optc-g -g'])
# TODO: Remove debug flags
test('stack_misc_closures',
[
- extra_files(['stack_misc_closures_c.c', 'stack_misc_closures_prim.cmm','stack_lib.c', 'TestUtils.hs']),
+ extra_files(['stack_misc_closures_c.c', 'stack_misc_closures_prim.cmm', 'TestUtils.hs']),
ignore_stdout,
ignore_stderr
],
@@ -101,7 +101,6 @@ test('stack_misc_closures',
['stack_misc_closures',
[ ('stack_misc_closures_c.c', '')
,('stack_misc_closures_prim.cmm', '')
- ,('stack_lib.c', '')
]
- , '-debug -optc-g -g -ddump-to-file -dlint -dppr-debug -ddump-cmm'
+ , '-debug -optc-g -optc-O0 -g -ddump-to-file -dlint -ddump-cmm'
])
=====================================
libraries/ghc-heap/tests/stack_big_ret.hs
=====================================
@@ -18,6 +18,7 @@ import GHC.Stack.CloneStack
import System.IO (hPutStrLn, stderr)
import System.Mem
import TestUtils
+import GHC.Exts.Heap
cloneStackReturnInt :: IORef (Maybe StackSnapshot) -> Int
cloneStackReturnInt ioRef = unsafePerformIO $ do
@@ -36,14 +37,15 @@ main = do
mbStackSnapshot <- readIORef stackRef
let stackSnapshot = fromJust mbStackSnapshot
- !decodedStack <- decodeStack' stackSnapshot
+ (SimpleStack boxedFrames) <- decodeStack stackSnapshot
+ stackFrames <- mapM getBoxedClosureData boxedFrames
- assertStackInvariants stackSnapshot decodedStack
+ assertStackInvariants stackSnapshot stackFrames
assertThat
"Stack contains one big return frame"
(== 1)
- (length $ filter isBigReturnFrame decodedStack)
- cs <- (mapM unbox . payload . head) $ filter isBigReturnFrame decodedStack
+ (length $ filter isBigReturnFrame stackFrames)
+ cs <- (mapM unbox . payload . head) $ filter isBigReturnFrame stackFrames
let xs = zip [1 ..] cs
mapM_ (uncurry checkArg) xs
=====================================
libraries/ghc-heap/tests/stack_lib.c deleted
=====================================
@@ -1,246 +0,0 @@
-#include "Rts.h"
-#include "RtsAPI.h"
-#include "rts/Messages.h"
-#include "rts/Types.h"
-#include "rts/storage/ClosureMacros.h"
-#include "rts/storage/ClosureTypes.h"
-#include "rts/storage/Closures.h"
-#include "stg/Types.h"
-#include <stdlib.h>
-
-typedef struct ClosureTypeList {
- struct ClosureTypeList *next;
- StgWord closureType;
-} ClosureTypeList;
-
-ClosureTypeList *last(ClosureTypeList *list) {
- while (list->next != NULL) {
- list = list->next;
- }
- return list;
-}
-ClosureTypeList *add(ClosureTypeList *list, StgWord closureType) {
- ClosureTypeList *newEntry = malloc(sizeof(ClosureTypeList));
- newEntry->next = NULL;
- newEntry->closureType = closureType;
- if (list != NULL) {
- last(list)->next = newEntry;
- } else {
- list = newEntry;
- }
- return list;
-}
-
-void freeList(ClosureTypeList *list) {
- ClosureTypeList *tmp;
- while (list != NULL) {
- tmp = list;
- list = list->next;
- free(tmp);
- }
-}
-
-StgWord listSize(ClosureTypeList *list) {
- StgWord s = 0;
- while (list != NULL) {
- list = list->next;
- s++;
- }
- return s;
-}
-
-ClosureTypeList *concat(ClosureTypeList *begin, ClosureTypeList *end) {
- last(begin)->next = end;
- return begin;
-}
-void printSmallBitmap(StgPtr spBottom, StgPtr payload, StgWord bitmap,
- uint32_t size);
-
-ClosureTypeList *foldSmallBitmapToList(StgPtr spBottom, StgPtr payload,
- StgWord bitmap, uint32_t size) {
- ClosureTypeList *list = NULL;
- uint32_t i;
-
- for (i = 0; i < size; i++, bitmap >>= 1) {
- if ((bitmap & 1) == 0) {
- const StgClosure *c = (StgClosure *)payload[i];
- c = UNTAG_CONST_CLOSURE(c);
- const StgInfoTable *info = get_itbl(c);
- list = add(list, info->type);
- }
- // TODO: Primitives are ignored here.
- }
-
- return list;
-}
-
-ClosureTypeList *foldLargeBitmapToList(StgPtr spBottom, StgPtr payload,
- StgLargeBitmap *large_bitmap,
- uint32_t size) {
- ClosureTypeList *list = NULL;
- StgWord bmp;
- uint32_t i, j;
-
- i = 0;
- for (bmp = 0; i < size; bmp++) {
- StgWord bitmap = large_bitmap->bitmap[bmp];
- j = 0;
- for (; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1) {
- if ((bitmap & 1) == 0) {
- const StgClosure *c = (StgClosure *)payload[i];
- c = UNTAG_CONST_CLOSURE(c);
- list = add(list, get_itbl(c)->type);
- }
- // TODO: Primitives are ignored here.
- }
- }
- return list;
-}
-
-// Do not traverse the whole heap. Instead add all closures that are on the
-// stack itself or referenced directly by such closures.
-ClosureTypeList *foldStackToList(StgStack *stack) {
- ClosureTypeList *result = NULL;
- StgPtr sp = stack->sp;
- StgPtr spBottom = stack->stack + stack->stack_size;
-
- for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
- const StgInfoTable *info = get_itbl((StgClosure *)sp);
-
- result = add(result, info->type);
- switch (info->type) {
- case UNDERFLOW_FRAME: {
- StgUnderflowFrame *f = (StgUnderflowFrame *)sp;
- result = concat(result, foldStackToList(f->next_chunk));
- continue;
- }
- case UPDATE_FRAME: {
- StgUpdateFrame *f = (StgUpdateFrame *)sp;
- result = add(result, get_itbl(UNTAG_CONST_CLOSURE(f->updatee))->type);
- continue;
- }
- case CATCH_FRAME: {
- StgCatchFrame *f = (StgCatchFrame *)sp;
- result = add(result, get_itbl(UNTAG_CONST_CLOSURE(f->handler))->type);
- continue;
- }
- case CATCH_RETRY_FRAME: {
- StgCatchRetryFrame *f = (StgCatchRetryFrame *)sp;
- result = add(result, get_itbl(UNTAG_CONST_CLOSURE(f->first_code))->type);
- result = add(result, get_itbl(UNTAG_CONST_CLOSURE(f->alt_code))->type);
- continue;
- }
- case STOP_FRAME: {
- continue;
- }
- case CATCH_STM_FRAME: {
- StgCatchSTMFrame *f = (StgCatchSTMFrame *)sp;
- result = add(result, get_itbl(UNTAG_CONST_CLOSURE(f->code))->type);
- result = add(result, get_itbl(UNTAG_CONST_CLOSURE(f->handler))->type);
- continue;
- }
- case ATOMICALLY_FRAME: {
- StgAtomicallyFrame *f = (StgAtomicallyFrame *)sp;
- result = add(result, get_itbl(UNTAG_CONST_CLOSURE(f->code))->type);
- result = add(result, get_itbl(UNTAG_CONST_CLOSURE(f->result))->type);
- continue;
- }
- case RET_SMALL: {
- StgWord bitmap = info->layout.bitmap;
- ClosureTypeList *bitmapList = foldSmallBitmapToList(
- spBottom, sp + 1, BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
- result = concat(result, bitmapList);
- continue;
- }
- case RET_BCO: {
- StgWord c = *sp;
- StgBCO *bco = ((StgBCO *)sp[1]);
- result = add(result, get_itbl((StgClosure*) bco)->type);
- ClosureTypeList *bitmapList = foldLargeBitmapToList(
- spBottom, sp + 2, BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
- result = concat(result, bitmapList);
- continue;
- }
- case RET_BIG: {
- StgLargeBitmap *bitmap = GET_LARGE_BITMAP(info);
- ClosureTypeList *bitmapList = foldLargeBitmapToList(
- spBottom, (StgPtr)((StgClosure *)sp)->payload, bitmap, bitmap->size);
- result = concat(result, bitmapList);
- continue;
- }
- case RET_FUN: {
- StgRetFun *ret_fun = (StgRetFun *)sp;
- const StgFunInfoTable *fun_info =
- get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
-
- result = add(result, fun_info->i.type);
-
- ClosureTypeList *bitmapList;
- switch (fun_info->f.fun_type) {
- case ARG_GEN:
- bitmapList = foldSmallBitmapToList(spBottom, sp + 3,
- BITMAP_BITS(fun_info->f.b.bitmap),
- BITMAP_SIZE(fun_info->f.b.bitmap));
- break;
- case ARG_GEN_BIG: {
- bitmapList = foldLargeBitmapToList(
- spBottom, sp + 3, GET_FUN_LARGE_BITMAP(fun_info),
- GET_FUN_LARGE_BITMAP(fun_info)->size);
- break;
- }
- default: {
- bitmapList = foldSmallBitmapToList(
- spBottom, sp + 3,
- BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
- BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]));
- break;
- }
- }
- result = concat(result, bitmapList);
- continue;
- }
- default: {
- errorBelch("Unexpected closure type: %us", info->type);
- break;
- }
- }
- }
-
- return result;
-}
-
-// Copied from Cmm.h
-/* Converting quantities of words to bytes */
-#define SIZEOF_W SIZEOF_VOID_P
-#define WDS(n) ((n)*SIZEOF_W)
-
-StgArrBytes *createArrayClosure(ClosureTypeList *list) {
- Capability *cap = rts_lock();
- // Mapping closure types to StgWord is pretty generous as they would fit
- // in Bytes. However, the handling of StgWords is much simpler.
- StgWord neededWords = listSize(list);
- StgArrBytes *array =
- (StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + neededWords);
- SET_HDR(array, &stg_ARR_WORDS_info, CCS_SYSTEM);
- array->bytes = WDS(listSize(list));
-
- for (int i = 0; list != NULL; i++) {
- array->payload[i] = list->closureType;
- list = list->next;
- }
- rts_unlock(cap);
- return array;
-}
-
-// Traverse the stack and return an arry representation of it's closure
-// types.
-StgArrBytes *foldStackToArrayClosure(StgStack *stack) {
- ClosureTypeList *cl = foldStackToList(stack);
- StgArrBytes *arrayClosure = createArrayClosure(cl);
- freeList(cl);
- return arrayClosure;
-}
-
-StgWord bytesInWord() {
- return SIZEOF_W;
-}
=====================================
libraries/ghc-heap/tests/stack_misc_closures.hs
=====================================
@@ -281,7 +281,9 @@ test setup assertion = do
-- when the GC suddenly does it's work and there were bad closures or pointers.
-- Better fail early, here.
performGC
- stack <- decodeStack' sn
+ (SimpleStack boxedFrames) <- decodeStack sn
+ performGC
+ stack <- mapM getBoxedClosureData boxedFrames
performGC
assert sn stack
-- The result of HasHeapRep should be similar (wrapped in the closure for
@@ -354,6 +356,9 @@ getWordFromConstr01 c = case c of
getWordFromBlackhole :: HasCallStack => Closure -> IO Word
getWordFromBlackhole c = case c of
BlackholeClosure {..} -> getWordFromConstr01 <$> getBoxedClosureData indirectee
+ -- For test stability reasons: Expect that the blackhole might have been
+ -- resolved.
+ ConstrClosure {..} -> pure $ head dataArgs
e -> error $ "Wrong closure type: " ++ show e
getWordFromUnknownTypeWordSizedPrimitive :: HasCallStack => Closure -> Word
=====================================
libraries/ghc-heap/tests/stack_stm_frames.hs
=====================================
@@ -11,6 +11,7 @@ import GHC.Exts.Heap.Closures
import GHC.Exts.Heap.InfoTable.Types
import GHC.Stack.CloneStack
import TestUtils
+import GHC.Exts.Heap
main :: IO ()
main = do
@@ -28,12 +29,6 @@ main = do
(== 1)
(length $ filter isAtomicallyFrame decodedStack)
-getDecodedStack :: IO (StackSnapshot, [Closure])
-getDecodedStack = do
- s <- cloneMyStack
- fs <- decodeStack' s
- pure (s, fs)
-
isCatchStmFrame :: Closure -> Bool
isCatchStmFrame (CatchStmFrame {..}) = tipe info == CATCH_STM_FRAME
isCatchStmFrame _ = False
=====================================
libraries/ghc-heap/tests/stack_underflow.hs
=====================================
@@ -20,8 +20,7 @@ loop n = print "x" >> loop (n - 1) >> print "x"
getStack :: HasCallStack => IO ()
getStack = do
- !s <- cloneMyStack
- !decodedStack <- decodeStack' s
+ (s, decodedStack) <- getDecodedStack
-- Uncomment to see the frames (for debugging purposes)
-- hPutStrLn stderr $ "Stack frames : " ++ show decodedStack
assertStackInvariants s decodedStack
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -97,7 +97,7 @@ run m = case m of
mapM (\case
Heap.Box x -> mkRemoteRef (HValue x)
-- TODO: Is this unsafeCoerce really necessary?
- Heap.DecodedClosureBox d -> mkRemoteRef (HValue (unsafeCoerce d))
+ Heap.DecodedBox d -> mkRemoteRef (HValue (unsafeCoerce d))
) clos
Seq ref -> doSeq ref
ResumeSeq ref -> resumeSeq ref
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50dc463b7a269a3e0ee8cb1d5ff8d2bbcb50792f...fc7e050bf60aa355f5d70cfd4608a317004391d6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50dc463b7a269a3e0ee8cb1d5ff8d2bbcb50792f...fc7e050bf60aa355f5d70cfd4608a317004391d6
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/20230124/2380ccd2/attachment-0001.html>
More information about the ghc-commits
mailing list