May 2025 - ghc-commits

[Git][ghc/ghc][wip/romes/top-level-bcos-tag] 2 commits: debugger/rts: Allow toggling step-in per thread
by Rodrigo Mesquita (＠alt-romes) 22 May '25

22 May '25

Rodrigo Mesquita pushed to branch wip/romes/top-level-bcos-tag at Glasgow Haskell Compiler / GHC Commits: 8844a0f9 by Rodrigo Mesquita at 2025-05-22T15:36:39+01:00 debugger/rts: Allow toggling step-in per thread The RTS global flag `rts_stop_next_breakpoint` globally sets the interpreter to stop at the immediate next breakpoint. With this commit, single step mode can additionally be set per thread in the TSO flag (TSO_STOP_NEXT_BREAKPOINT). Being able to toggle "stop at next breakpoint" per thread is an important requirement for implementing "stepping out" of a function in a multi-threaded context. And, more generally, having a per-thread flag for single-stepping paves the way for multi-threaded debugging. That said, when we want to enable "single step" mode for the whole interpreted program we still want to stop at the immediate next breakpoint, whichever thread it belongs to. That's why we also keep the global `rts_stop_next_breakpoint` flag, with `rts_enableStopNextBreakpointAll` and `rts_disableStopNextBreakpointAll` helpers. Preparation for #26042 - - - - - aef92286 by Rodrigo Mesquita at 2025-05-22T18:08:23+01:00 rts: Case continuation BCOs This commit introduces the `stg_CASE_CONT_BCO` info table, which is identical to `stg_BCO` and shares the same closure type (== BCO). It changes the bytecode generator to always use `stg_CASE_CONT_BCO_info` when constructing case continuation BCOs, and remain using `stg_BCO` otherwise. This allows us to distinguish at runtime case continuation BCOs from other BCOs. In particular, this is relevant because, unlike other BCOs, the code of a case continuation BCO may refer to variables in its parent's stack frame (ie non-local variables), and therefore its frame position on the stack cannot be changed in isolation. The full motivation and details are in Note [Case continuation BCOs]. Towards #26042 - - - - - 24 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/StgToByteCode.hs - libraries/base/src/GHC/Exts.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc - libraries/ghc-heap/tests/parse_tso_flags.hs - libraries/ghc-internal/src/GHC/Internal/Exts.hs - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/ResolvedBCO.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - rts/Interpreter.c - rts/Interpreter.h - rts/PrimOps.cmm - rts/Printer.c - rts/RtsSymbols.c - rts/StgMiscClosures.cmm - rts/include/rts/Constants.h - rts/include/stg/MiscClosures.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3872,12 +3872,13 @@ primop MkApUpd0_Op "mkApUpd0#" GenPrimOp with out_of_line = True -primop NewBCOOp "newBCO#" GenPrimOp - ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #) - { @'newBCO#' instrs lits ptrs arity bitmap@ creates a new bytecode object. The +primop NewBCOOp "newBCO2#" GenPrimOp + Int8# -> ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #) + { @'newBCO2#' is_case_cont instrs lits ptrs arity bitmap@ creates a new bytecode object. The resulting object encodes a function of the given arity with the instructions encoded in @instrs@, and a static reference table usage bitmap given by - @bitmap@. } + @bitmap@. The @is_case_cont@ boolean indicates whether the BCO is a case + continuation (see Note [Case continuation BCOs]) } with effect = ReadWriteEffect out_of_line = True ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -85,7 +85,7 @@ bcoFreeNames :: UnlinkedBCO -> UniqDSet Name bcoFreeNames bco = bco_refs bco `uniqDSetMinusUniqSet` mkNameSet [unlinkedBCOName bco] where - bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs) + bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs _) = unionManyUniqDSets ( mkUniqDSet [ n | BCOPtrName n <- elemsFlatBag ptrs ] : mkUniqDSet [ n | BCONPtrItbl n <- elemsFlatBag nonptrs ] : @@ -236,7 +236,8 @@ assembleBCO platform , protoBCOInstrs = instrs , protoBCOBitmap = bitmap , protoBCOBitmapSize = bsize - , protoBCOArity = arity }) = do + , protoBCOArity = arity + , protoBCOIsCaseCont = isCC }) = do -- pass 1: collect up the offsets of the local labels. let initial_offset = 0 @@ -266,7 +267,7 @@ assembleBCO platform let !insns_arr = mkBCOByteArray $ final_isn_array !bitmap_arr = mkBCOByteArray $ mkBitmapArray bsize bitmap - ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSmallArray final_lit_array) (fromSmallArray final_ptr_array) + ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSmallArray final_lit_array) (fromSmallArray final_ptr_array) isCC -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive -- objects, since they might get run too early. Disable this until ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -53,7 +53,8 @@ data ProtoBCO a -- what the BCO came from, for debugging only protoBCOExpr :: Either [CgStgAlt] CgStgRhs, -- malloc'd pointers - protoBCOFFIs :: [FFIInfo] + protoBCOFFIs :: [FFIInfo], + protoBCOIsCaseCont :: !Bool -- See Note [Case continuation BCOs] } -- | A local block label (e.g. identifying a case alternative). ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -59,7 +59,7 @@ linkBCO -> UnlinkedBCO -> IO ResolvedBCO linkBCO interp pkgs_loaded le bco_ix - (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do + (UnlinkedBCO _ arity insns bitmap lits0 ptrs0 isCC) = 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 :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (elemsFlatBag lits0) @@ -69,7 +69,7 @@ linkBCO interp pkgs_loaded le bco_ix insns bitmap (mkBCOByteArray lits') - (addListToSS emptySS ptrs)) + (addListToSS emptySS ptrs) isCC) lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word lookupLiteral interp pkgs_loaded le ptr = case ptr of ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -167,14 +167,109 @@ newtype ItblPtr = ItblPtr (RemotePtr Heap.StgInfoTable) newtype AddrPtr = AddrPtr (RemotePtr ()) deriving (NFData) +{- +-------------------------------------------------------------------------------- +-- * Byte Code Objects (BCOs) +-------------------------------------------------------------------------------- + +Note [Case continuation BCOs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +A stack with a BCO stack frame at the top looks like: + + (an StgBCO) + | ... | +---> +---------[1]--+ + +------------------+ | | info_tbl_ptr | ------+ + | OTHER FRAME | | +--------------+ | + +------------------+ | | StgArrBytes* | <--- the byte code + | ... | | +--------------+ | + +------------------+ | | ... | | + | fvs1 | | | + +------------------+ | | + | ... | | (StgInfoTable) | + +------------------+ | +----------+ <---+ + | args1 | | | ... | + +------------------+ | +----------+ + | some StgBCO* | -----+ | type=BCO | + +------------------+ +----------+ + Sp | stg_apply_interp | -----+ | ... | + +------------------+ | + | + | (StgInfoTable) + +----> +--------------+ + | ... | + +--------------+ + | type=RET_BCO | + +--------------+ + | ... | + + +The byte code for a BCO heap object makes use of arguments and free variables +which can typically be found within the BCO stack frame. In the code, these +variables are referenced via a statically known stack offset (tracked using +`BCEnv` in `StgToByteCode`). + +However, in /case continuation/ BCOs, the code may additionally refer to free +variables that are outside of that BCO's stack frame -- some free variables of a +case continuation BCO may only be found in the stack frame of a parent BCO. + +Yet, references to these out-of-frame variables are also done in terms of stack +offsets. Thus, they rely on the position of /another frame/ to be fixed. (See +Note [PUSH_L underflow] for more information about references to previous +frames and nested BCOs) + +This makes case continuation BCOs special: unlike normal BCOs, case cont BCO +frames cannot be moved on the stack independently from their parent BCOs. + +In order to be able to distinguish them at runtime, the code generator will use +distinct info table pointers for their closures, even though they will have the +same structure on the heap (StgBCO). Specifically: + + - Normal BCOs are always headed by the `stg_BCO_info` pointer. + - Case continuation BCOs are always headed by the `stg_CASE_CONT_BCO_info` pointer. + +A primary reason why we need to distinguish these two cases is to know where we +can insert a debugger step-out frame (`stg_stop_after_ret_frame`). In +particular, because case cont BCOs may refer to the parent frame, we must not +insert step-out frames between a case cont BCO and its parent. +See Note [Debugger: Step-out] for further details. + +As an example, consider the following, where `y` is free in the case alternatives: + + f x y = case x of + True -> y - 1 + False -> y + 1 :: Int + +While interpreting f, the args x and y will be on the stack as part of f's frame. +In its body, a case continuation BCO is pushed (PUSH_ALTS) and then `x` is +entered to be evaluated. Upon entering `x`, the stack would look something like: + + <f arg 2> + <f arg 1> + ... + <Case continuation BCO Frame> + +We cannot insert a step out frame in between: + + + <f arg 2> + <f arg 1> + ... + <inserted step-out frame> <--- BAD! Breaks stack offsets in the case cont. + <Case continuation BCO Frame> + +Instead, we must traverse until the parent BCO and insert the step-out frame before it instead. +-} + data UnlinkedBCO = UnlinkedBCO { unlinkedBCOName :: !Name, unlinkedBCOArity :: {-# UNPACK #-} !Int, - unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns - unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap + unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns + unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap unlinkedBCOLits :: !(FlatBag BCONPtr), -- non-ptrs - unlinkedBCOPtrs :: !(FlatBag BCOPtr) -- ptrs + unlinkedBCOPtrs :: !(FlatBag BCOPtr), -- ptrs + unlinkedBCOIsCaseCont :: !Bool -- See Note [Case continuation BCOs] } instance NFData UnlinkedBCO where @@ -227,10 +322,11 @@ seqCgBreakInfo CgBreakInfo{..} = rnf cgb_resty instance Outputable UnlinkedBCO where - ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs) + ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs pi) = sep [text "BCO", ppr nm, text "with", ppr (sizeFlatBag lits), text "lits", - ppr (sizeFlatBag ptrs), text "ptrs" ] + ppr (sizeFlatBag ptrs), text "ptrs", + ppr pi, text "is_pos_indep"] instance Outputable CgBreakInfo where ppr info = text "CgBreakInfo" <+> ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -253,7 +253,11 @@ mkProtoBCO -> Int -- ^ arity -> WordOff -- ^ bitmap size -> [StgWord] -- ^ bitmap - -> Bool -- ^ True <=> is a return point, rather than a function + -> Bool -- ^ True <=> it's a case continuation, rather than a function + -- Used for + -- (A) Stack check collision and + -- (B) Mark the BCO wrt whether it contains non-local stack + -- references. See Note [Case continuation BCOs]. -> [FFIInfo] -> ProtoBCO Name mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis @@ -264,7 +268,8 @@ mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bit protoBCOBitmapSize = fromIntegral bitmap_size, protoBCOArity = arity, protoBCOExpr = origin, - protoBCOFFIs = ffis + protoBCOFFIs = ffis, + protoBCOIsCaseCont = is_ret } where #if MIN_VERSION_rts(1,0,3) @@ -353,6 +358,9 @@ schemeTopBind (id, rhs) -- Park the resulting BCO in the monad. Also requires the -- name of the variable to which this value was bound, -- so as to give the resulting BCO a name. +-- +-- The resulting ProtoBCO expects the free variables and the function arguments +-- to be in the stack directly before it. schemeR :: [Id] -- Free vars of the RHS, ordered as they -- will appear in the thunk. Empty for -- top-level things, which have no free vars. @@ -391,6 +399,8 @@ schemeR_wrk fvs nm original_body (args, body) -- them unlike constructor fields. szsb_args = map (wordsToBytes platform . idSizeW platform) all_args sum_szsb_args = sum szsb_args + -- Make a stack offset for each argument or free var -- they should + -- appear contiguous in the stack, in order. p_init = Map.fromList (zip all_args (mkStackOffsets 0 szsb_args)) -- make the arg bitmap @@ -1401,7 +1411,7 @@ Note [unboxed tuple bytecodes and tuple_BCO] tupleBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name tupleBCO platform args_info args = mkProtoBCO platform Nothing invented_name body_code (Left []) - 0{-no arity-} bitmap_size bitmap False{-is alts-} + 0{-no arity-} bitmap_size bitmap False{-not alts-} where {- The tuple BCO is never referred to by name, so we can get away @@ -1422,7 +1432,7 @@ tupleBCO platform args_info args = primCallBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name primCallBCO platform args_info args = mkProtoBCO platform Nothing invented_name body_code (Left []) - 0{-no arity-} bitmap_size bitmap False{-is alts-} + 0{-no arity-} bitmap_size bitmap False{-not alts-} where {- The primcall BCO is never referred to by name, so we can get away ===================================== libraries/base/src/GHC/Exts.hs ===================================== @@ -26,12 +26,12 @@ module GHC.Exts -- ** Legacy interface for arrays of arrays module GHC.Internal.ArrayArray, -- * Primitive operations - {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-} + {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 10.14", "These symbols should be imported from ghc-internal instead if needed."] #-} Prim.BCO, {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-} Prim.mkApUpd0#, {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-} - Prim.newBCO#, + IExts.newBCO#, module GHC.Prim, module GHC.Prim.Ext, -- ** Running 'RealWorld' state thread @@ -119,7 +119,7 @@ module GHC.Exts maxTupleSize ) where -import GHC.Internal.Exts +import GHC.Internal.Exts hiding ( newBCO# ) import GHC.Internal.ArrayArray import GHC.Prim hiding ( coerce @@ -132,7 +132,7 @@ import GHC.Prim hiding , isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned# -- deprecated - , BCO, mkApUpd0#, newBCO# + , BCO, mkApUpd0# -- Don't re-export vector FMA instructions , fmaddFloatX4# @@ -256,8 +256,10 @@ import GHC.Prim hiding , minWord8X32# , minWord8X64# ) +import qualified GHC.Internal.Exts as IExts + ( newBCO# ) import qualified GHC.Prim as Prim - ( BCO, mkApUpd0#, newBCO# ) + ( BCO, mkApUpd0# ) import GHC.Prim.Ext ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -624,6 +624,7 @@ data TsoFlags | TsoMarked | TsoSqueezed | TsoAllocLimit + | TsoStopNextBreakpoint | TsoFlagsUnknownValue Word32 -- ^ Please report this as a bug deriving (Eq, Show, Generic, Ord) ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc ===================================== @@ -87,6 +87,9 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset | isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w) | isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w) | isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w) +#if __GLASGOW_HASKELL__ >= 913 + | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w) +#endif parseTsoFlags 0 = [] parseTsoFlags w = [TsoFlagsUnknownValue w] ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc ===================================== @@ -87,6 +87,9 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset | isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w) | isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w) | isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w) +#if __GLASGOW_HASKELL__ >= 913 + | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w) +#endif parseTsoFlags 0 = [] parseTsoFlags w = [TsoFlagsUnknownValue w] ===================================== libraries/ghc-heap/tests/parse_tso_flags.hs ===================================== @@ -13,5 +13,6 @@ main = do assertEqual (parseTsoFlags 64) [TsoMarked] assertEqual (parseTsoFlags 128) [TsoSqueezed] assertEqual (parseTsoFlags 256) [TsoAllocLimit] + assertEqual (parseTsoFlags 512) [TsoStopNextBreakpoint] assertEqual (parseTsoFlags 6) [TsoLocked, TsoBlockx] ===================================== libraries/ghc-internal/src/GHC/Internal/Exts.hs ===================================== @@ -163,6 +163,9 @@ module GHC.Internal.Exts -- * The maximum tuple size maxTupleSize, + + -- * Interpreter + newBCO# ) where import GHC.Internal.Prim hiding ( coerce, dataToTagSmall#, dataToTagLarge#, whereFrom# ) @@ -469,3 +472,18 @@ resizeSmallMutableArray# arr0 szNew a s0 = -- accessible\" by word. considerAccessible :: Bool considerAccessible = True + +-------------------------------------------------------------------------------- +-- Interpreter + +{-| +@'newBCO#' instrs lits ptrs arity bitmap@ creates a new bytecode object. The +resulting object encodes a function of the given arity with the instructions +encoded in @instrs@, and a static reference table usage bitmap given by +@bitmap@. + +Note: Case continuation BCOs, with non-local stack references, must be +constructed using @'newBCO2#' 1@ instead. See Note [Case continuation BCOs]. +-} +newBCO# :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #) +newBCO# b1 b2 a1 i1 b3 s = newBCO2# (intToInt8# 0#) b1 b2 a1 i1 b3 s ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -87,11 +87,11 @@ linkBCO' arr ResolvedBCO{..} = do literals_barr = barr (getBCOByteArray resolvedBCOLits) PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs + let is_case_cont | resolvedBCOIsCaseCont = intToInt8# 1# + | otherwise = intToInt8# 0# IO $ \s -> case unsafeFreezeArray# marr s of { (# s, arr #) -> - case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io -> - io s - }} + newBCO2# is_case_cont insns_barr literals_barr arr arity# bitmap_barr s } -- we recursively link any sub-BCOs while making the ptrs array ===================================== libraries/ghci/GHCi/ResolvedBCO.hs ===================================== @@ -45,7 +45,8 @@ data ResolvedBCO resolvedBCOBitmap :: BCOByteArray Word, -- ^ bitmap resolvedBCOLits :: BCOByteArray Word, -- ^ non-ptrs - subword sized entries still take up a full (host) word - resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr) -- ^ ptrs + resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr), -- ^ ptrs + resolvedBCOIsCaseCont :: !Bool -- ^ See Note [Case continuation BCOs] } deriving (Generic, Show) @@ -86,7 +87,8 @@ instance Binary ResolvedBCO where put resolvedBCOBitmap put resolvedBCOLits put resolvedBCOPtrs - get = ResolvedBCO <$> get <*> get <*> get <*> get <*> get <*> get + put resolvedBCOIsCaseCont + get = ResolvedBCO <$> get <*> get <*> get <*> get <*> get <*> get <*> get -- See Note [BCOByteArray serialization] instance (Binary a, Storable a, IArray UArray a) => Binary (BCOByteArray a) where ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP, - UnboxedTuples, LambdaCase #-} + UnboxedTuples, LambdaCase, UnliftedFFITypes #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | @@ -20,6 +20,7 @@ import GHCi.InfoTable #endif import qualified GHC.InfoProv as InfoProv +import GHCi.Debugger import GHCi.FFI import GHCi.Message import GHCi.ObjLink @@ -332,7 +333,7 @@ withBreakAction opts breakMVar statusMVar act stablePtr <- newStablePtr onBreak poke breakPointIOAction stablePtr when (breakOnException opts) $ poke exceptionFlag 1 - when (singleStep opts) $ setStepFlag + when (singleStep opts) rts_enableStopNextBreakpointAll return stablePtr -- Breaking on exceptions is not enabled by default, since it -- might be a bit surprising. The exception flag is turned off @@ -363,7 +364,7 @@ withBreakAction opts breakMVar statusMVar act resetBreakAction stablePtr = do poke breakPointIOAction noBreakStablePtr poke exceptionFlag 0 - resetStepFlag + rts_disableStopNextBreakpointAll freeStablePtr stablePtr resumeStmt @@ -396,28 +397,6 @@ abandonStmt hvref = do _ <- takeMVar resumeStatusMVar return () -foreign import ccall "&rts_stop_next_breakpoint" stepFlag :: Ptr CInt -foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt - -setStepFlag :: IO () -setStepFlag = poke stepFlag 1 -resetStepFlag :: IO () -resetStepFlag = poke stepFlag 0 - -type BreakpointCallback - = Addr# -- pointer to the breakpoint tick module name - -> Addr# -- pointer to the breakpoint tick module unit id - -> Int# -- breakpoint tick index - -> Addr# -- pointer to the breakpoint info module name - -> Addr# -- pointer to the breakpoint info module unit id - -> Int# -- breakpoint info index - -> Bool -- exception? - -> HValue -- the AP_STACK, or exception - -> IO () - -foreign import ccall "&rts_breakpoint_io_action" - breakPointIOAction :: Ptr (StablePtr BreakpointCallback) - noBreakStablePtr :: StablePtr BreakpointCallback noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -60,6 +60,7 @@ library CPP-Options: -DHAVE_INTERNAL_INTERPRETER exposed-modules: GHCi.Run + GHCi.Debugger GHCi.CreateBCO GHCi.ObjLink GHCi.Signals ===================================== rts/Interpreter.c ===================================== @@ -203,14 +203,14 @@ PUSH_L instruction. |---------| | BCO_1 | -<-┐ -|---------| +|---------| | ......... | |---------| | PUSH_L <n> | BCO_N | ->-┘ |---------| Here BCO_N is syntactically nested within the code for BCO_1 and will result -in code that references the prior stack frame of BCO_1 for some of it's local +in code that references the prior stack frame of BCO_1 for some of its local variables. If a stack overflow happens between the creation of the stack frame for BCO_1 and BCO_N the RTS might move BCO_N to a new stack chunk while leaving BCO_1 in place, invalidating a simple offset based reference to the outer stack @@ -243,9 +243,44 @@ allocate_NONUPD (Capability *cap, int n_words) return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words)); } -int rts_stop_next_breakpoint = 0; int rts_stop_on_exception = 0; +/* --------------------------------------------------------------------------- + * Enabling and disabling global single step mode + * ------------------------------------------------------------------------ */ + +/* A global toggle for single-step mode. + * Unlike `TSO_STOP_NEXT_BREAKPOINT`, which sets single-step mode per-thread, + * `rts_stop_next_breakpoint` globally enables single-step mode. If enabled, we + * will stop at the immediate next breakpoint regardless of what thread it is in. */ +int rts_stop_next_breakpoint = 0; + +void rts_enableStopNextBreakpointAll(void) +{ + rts_stop_next_breakpoint = 1; +} + +void rts_disableStopNextBreakpointAll(void) +{ + rts_stop_next_breakpoint = 0; +} + +/* --------------------------------------------------------------------------- + * Enabling and disabling per-thread single step mode + * ------------------------------------------------------------------------ */ + +void rts_enableStopNextBreakpoint(StgPtr tso) +{ + ((StgTSO *)tso)->flags |= TSO_STOP_NEXT_BREAKPOINT; +} + +void rts_disableStopNextBreakpoint(StgPtr tso) +{ + ((StgTSO *)tso)->flags &= ~TSO_STOP_NEXT_BREAKPOINT; +} + +/* -------------------------------------------------------------------------- */ + #if defined(INTERP_STATS) #define N_CODES 128 @@ -508,14 +543,35 @@ interpretBCO (Capability* cap) // // We have a BCO application to perform. Stack looks like: // - // | .... | - // +---------------+ - // | arg1 | - // +---------------+ - // | BCO | - // +---------------+ - // Sp | RET_BCO | - // +---------------+ + // + // (an StgBCO) + // +---> +---------[1]--+ + // | | stg_BCO_info | ------+ + // | +--------------+ | + // | | StgArrBytes* | <--- the byte code + // | ... | | +--------------+ | + // +------------------+ | | ... | | + // | fvs1 | | | + // +------------------+ | | + // | ... | | (StgInfoTable) | + // +------------------+ | +----------+ <---+ + // | args1 | | | ... | + // +------------------+ | +----------+ + // | some StgBCO* | -----+ | type=BCO | + // +------------------+ +----------+ + // Sp | stg_apply_interp | -----+ | ... | + // +------------------+ | + // | + // | (StgInfoTable) + // +----> +--------------+ + // | ... | + // +--------------+ + // | type=RET_BCO | + // +--------------+ + // | ... | + // + // [1] An StgBCO's info table pointer may also be stg_CASE_CONT_BCO_info. + // See Note [Case continuation BCOs]. // else if (SpW(0) == (W_)&stg_apply_interp_info) { obj = UNTAG_CLOSURE((StgClosure *)ReadSpW(1)); @@ -1250,7 +1306,7 @@ run_BCO: int arg8_cc; #endif StgArrBytes *breakPoints; - int returning_from_break; + int returning_from_break, stop_next_breakpoint; // the io action to run at a breakpoint StgClosure *ioAction; @@ -1280,6 +1336,13 @@ run_BCO: returning_from_break = cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT; + // check whether this thread is set to stop at the immediate next + // breakpoint -- either by the global `rts_stop_next_breakpoint` + // flag, or by the local `TSO_STOP_NEXT_BREAKPOINT` + stop_next_breakpoint = + rts_stop_next_breakpoint || + cap->r.rCurrentTSO->flags & TSO_STOP_NEXT_BREAKPOINT; + #if defined(PROFILING) cap->r.rCCCS = pushCostCentre(cap->r.rCCCS, (CostCentre*)BCO_LIT(arg8_cc)); @@ -1291,20 +1354,20 @@ run_BCO: { breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array); - // stop the current thread if either the - // "rts_stop_next_breakpoint" flag is true OR if the - // ignore count for this particular breakpoint is zero + // stop the current thread if either `stop_next_breakpoint` is + // true OR if the ignore count for this particular breakpoint is zero StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index]; - if (rts_stop_next_breakpoint == false && ignore_count > 0) + if (stop_next_breakpoint == false && ignore_count > 0) { // decrement and write back ignore count ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count; } - else if (rts_stop_next_breakpoint == true || ignore_count == 0) + else if (stop_next_breakpoint == true || ignore_count == 0) { // make sure we don't automatically stop at the // next breakpoint - rts_stop_next_breakpoint = false; + rts_stop_next_breakpoint = 0; + cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT; // allocate memory for a new AP_STACK, enough to // store the top stack frame plus an @@ -1477,7 +1540,7 @@ run_BCO: // Here we make sure references we push are tagged. // See Note [CBV Functions and the interpreter] in Info.hs - //Safe some memory reads if we already have a tag. + //Save some memory reads if we already have a tag. if(GET_CLOSURE_TAG(tagged_obj) == 0) { StgClosure *obj = UNTAG_CLOSURE(tagged_obj); switch ( get_itbl(obj)->type ) { ===================================== rts/Interpreter.h ===================================== @@ -11,3 +11,8 @@ RTS_PRIVATE Capability *interpretBCO (Capability* cap); void interp_startup ( void ); void interp_shutdown ( void ); + +void rts_enableStopNextBreakpointAll ( void ); +void rts_disableStopNextBreakpointAll ( void ); +void rts_enableStopNextBreakpoint ( StgPtr ); +void rts_disableStopNextBreakpoint ( StgPtr ); ===================================== rts/PrimOps.cmm ===================================== @@ -55,6 +55,7 @@ import CLOSURE stg_AP_STACK_info; import CLOSURE stg_AP_info; import CLOSURE stg_ARR_WORDS_info; import CLOSURE stg_BCO_info; +import CLOSURE stg_CASE_CONT_BCO_info; import CLOSURE stg_C_FINALIZER_LIST_info; import CLOSURE stg_DEAD_WEAK_info; import CLOSURE stg_END_STM_WATCH_QUEUE_closure; @@ -2434,7 +2435,8 @@ stg_deRefStablePtrzh ( P_ sp ) Bytecode object primitives ------------------------------------------------------------------------- */ -stg_newBCOzh ( P_ instrs, +stg_newBCO2zh ( CBool is_case_cont, + P_ instrs, P_ literals, P_ ptrs, W_ arity, @@ -2449,7 +2451,16 @@ stg_newBCOzh ( P_ instrs, bco = Hp - bytes + WDS(1); // No memory barrier necessary as this is a new allocation. - SET_HDR(bco, stg_BCO_info, CCS_MAIN); + if (is_case_cont > 0) { + /* Uses stg_CASE_CONT_BCO_info to construct the BCO frame (rather than stg_BCO_info). + * Case continuations may contain non-local references to parent frames. The distinct info table + * tag allows the RTS to identify such non-local frames. + * See Note [Case continuation BCOs] + */ + SET_HDR(bco, stg_CASE_CONT_BCO_info, CCS_MAIN); + } else { + SET_HDR(bco, stg_BCO_info, CCS_MAIN); + } StgBCO_instrs(bco) = instrs; StgBCO_literals(bco) = literals; ===================================== rts/Printer.c ===================================== @@ -690,6 +690,8 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) debugBelch("stg_ctoi_V_info" ); } else if (c == (StgWord)&stg_BCO_info) { debugBelch("stg_BCO_info" ); + } else if (c == (StgWord)&stg_CASE_CONT_BCO_info) { + debugBelch("stg_CASE_CONT_BCO_info" ); } else if (c == (StgWord)&stg_apply_interp_info) { debugBelch("stg_apply_interp_info" ); } else if (c == (StgWord)&stg_ret_t_info) { ===================================== rts/RtsSymbols.c ===================================== @@ -639,7 +639,7 @@ extern char **environ; SymI_HasDataProto(stg_copySmallMutableArrayzh) \ SymI_HasDataProto(stg_casSmallArrayzh) \ SymI_HasDataProto(stg_copyArray_barrier) \ - SymI_HasDataProto(stg_newBCOzh) \ + SymI_HasDataProto(stg_newBCO2zh) \ SymI_HasDataProto(stg_newByteArrayzh) \ SymI_HasDataProto(stg_casIntArrayzh) \ SymI_HasDataProto(stg_casInt8Arrayzh) \ @@ -906,7 +906,8 @@ extern char **environ; SymI_HasProto(revertCAFs) \ SymI_HasProto(RtsFlags) \ SymI_NeedsDataProto(rts_breakpoint_io_action) \ - SymI_NeedsDataProto(rts_stop_next_breakpoint) \ + SymI_NeedsDataProto(rts_enableStopNextBreakpointAll) \ + SymI_NeedsDataProto(rts_disableStopNextBreakpointAll) \ SymI_NeedsDataProto(rts_stop_on_exception) \ SymI_HasProto(stopTimer) \ SymI_HasProto(n_capabilities) \ ===================================== rts/StgMiscClosures.cmm ===================================== @@ -464,6 +464,12 @@ INFO_TABLE_RET( stg_dead_thread, RET_SMALL, /* ---------------------------------------------------------------------------- Entry code for a BCO + + `stg_BCO` and `stg_CASE_CONT_BCO` distinguish between a BCO that refers to + non-local variables in its code (using a stack offset) and those that do not. + Only case-continuation BCOs should use non-local variables. + Otherwise, `stg_BCO` and `stg_CASE_CONT_BCO` behave the same. + See Note [Case continuation BCOs]. ------------------------------------------------------------------------- */ INFO_TABLE_FUN( stg_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO ) @@ -478,6 +484,15 @@ INFO_TABLE_FUN( stg_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO ) jump stg_yield_to_interpreter []; } +INFO_TABLE_FUN( stg_CASE_CONT_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO ) +{ + /* Exactly as for stg_BCO */ + Sp_adj(-2); + Sp(1) = R1; + Sp(0) = stg_apply_interp_info; + jump stg_yield_to_interpreter []; +} + /* ---------------------------------------------------------------------------- Info tables for indirections. ===================================== rts/include/rts/Constants.h ===================================== @@ -328,6 +328,12 @@ */ #define TSO_ALLOC_LIMIT 256 +/* + * Enables step-in mode for this thread -- it will stop at the immediate next + * breakpoint found in this thread. + */ +#define TSO_STOP_NEXT_BREAKPOINT 512 + /* * The number of times we spin in a spin lock before yielding (see * #3758). To tune this value, use the benchmark in #3758: run the ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -180,6 +180,7 @@ RTS_ENTRY(stg_BLOCKING_QUEUE_CLEAN); RTS_ENTRY(stg_BLOCKING_QUEUE_DIRTY); RTS_FUN(stg_BCO); +RTS_FUN(stg_CASE_CONT_BCO); RTS_ENTRY(stg_EVACUATED); RTS_ENTRY(stg_WEAK); RTS_ENTRY(stg_DEAD_WEAK); @@ -577,7 +578,7 @@ RTS_FUN_DECL(stg_deRefWeakzh); RTS_FUN_DECL(stg_runRWzh); -RTS_FUN_DECL(stg_newBCOzh); +RTS_FUN_DECL(stg_newBCO2zh); RTS_FUN_DECL(stg_mkApUpd0zh); RTS_FUN_DECL(stg_retryzh); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cb4a42f690d13d3f1424913691be5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cb4a42f690d13d3f1424913691be5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/per-thread-step-in] debugger/rts: Allow toggling step-in per thread
by Rodrigo Mesquita (＠alt-romes) 22 May '25

22 May '25

Rodrigo Mesquita pushed to branch wip/romes/per-thread-step-in at Glasgow Haskell Compiler / GHC Commits: 8844a0f9 by Rodrigo Mesquita at 2025-05-22T15:36:39+01:00 debugger/rts: Allow toggling step-in per thread The RTS global flag `rts_stop_next_breakpoint` globally sets the interpreter to stop at the immediate next breakpoint. With this commit, single step mode can additionally be set per thread in the TSO flag (TSO_STOP_NEXT_BREAKPOINT). Being able to toggle "stop at next breakpoint" per thread is an important requirement for implementing "stepping out" of a function in a multi-threaded context. And, more generally, having a per-thread flag for single-stepping paves the way for multi-threaded debugging. That said, when we want to enable "single step" mode for the whole interpreted program we still want to stop at the immediate next breakpoint, whichever thread it belongs to. That's why we also keep the global `rts_stop_next_breakpoint` flag, with `rts_enableStopNextBreakpointAll` and `rts_disableStopNextBreakpointAll` helpers. Preparation for #26042 - - - - - 10 changed files: - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc - libraries/ghc-heap/tests/parse_tso_flags.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - rts/Interpreter.c - rts/Interpreter.h - rts/RtsSymbols.c - rts/include/rts/Constants.h Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -624,6 +624,7 @@ data TsoFlags | TsoMarked | TsoSqueezed | TsoAllocLimit + | TsoStopNextBreakpoint | TsoFlagsUnknownValue Word32 -- ^ Please report this as a bug deriving (Eq, Show, Generic, Ord) ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc ===================================== @@ -87,6 +87,9 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset | isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w) | isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w) | isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w) +#if __GLASGOW_HASKELL__ >= 913 + | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w) +#endif parseTsoFlags 0 = [] parseTsoFlags w = [TsoFlagsUnknownValue w] ===================================== libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc ===================================== @@ -87,6 +87,9 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset | isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w) | isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w) | isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w) +#if __GLASGOW_HASKELL__ >= 913 + | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w) +#endif parseTsoFlags 0 = [] parseTsoFlags w = [TsoFlagsUnknownValue w] ===================================== libraries/ghc-heap/tests/parse_tso_flags.hs ===================================== @@ -13,5 +13,6 @@ main = do assertEqual (parseTsoFlags 64) [TsoMarked] assertEqual (parseTsoFlags 128) [TsoSqueezed] assertEqual (parseTsoFlags 256) [TsoAllocLimit] + assertEqual (parseTsoFlags 512) [TsoStopNextBreakpoint] assertEqual (parseTsoFlags 6) [TsoLocked, TsoBlockx] ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP, - UnboxedTuples, LambdaCase #-} + UnboxedTuples, LambdaCase, UnliftedFFITypes #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | @@ -20,6 +20,7 @@ import GHCi.InfoTable #endif import qualified GHC.InfoProv as InfoProv +import GHCi.Debugger import GHCi.FFI import GHCi.Message import GHCi.ObjLink @@ -332,7 +333,7 @@ withBreakAction opts breakMVar statusMVar act stablePtr <- newStablePtr onBreak poke breakPointIOAction stablePtr when (breakOnException opts) $ poke exceptionFlag 1 - when (singleStep opts) $ setStepFlag + when (singleStep opts) rts_enableStopNextBreakpointAll return stablePtr -- Breaking on exceptions is not enabled by default, since it -- might be a bit surprising. The exception flag is turned off @@ -363,7 +364,7 @@ withBreakAction opts breakMVar statusMVar act resetBreakAction stablePtr = do poke breakPointIOAction noBreakStablePtr poke exceptionFlag 0 - resetStepFlag + rts_disableStopNextBreakpointAll freeStablePtr stablePtr resumeStmt @@ -396,28 +397,6 @@ abandonStmt hvref = do _ <- takeMVar resumeStatusMVar return () -foreign import ccall "&rts_stop_next_breakpoint" stepFlag :: Ptr CInt -foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt - -setStepFlag :: IO () -setStepFlag = poke stepFlag 1 -resetStepFlag :: IO () -resetStepFlag = poke stepFlag 0 - -type BreakpointCallback - = Addr# -- pointer to the breakpoint tick module name - -> Addr# -- pointer to the breakpoint tick module unit id - -> Int# -- breakpoint tick index - -> Addr# -- pointer to the breakpoint info module name - -> Addr# -- pointer to the breakpoint info module unit id - -> Int# -- breakpoint info index - -> Bool -- exception? - -> HValue -- the AP_STACK, or exception - -> IO () - -foreign import ccall "&rts_breakpoint_io_action" - breakPointIOAction :: Ptr (StablePtr BreakpointCallback) - noBreakStablePtr :: StablePtr BreakpointCallback noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -60,6 +60,7 @@ library CPP-Options: -DHAVE_INTERNAL_INTERPRETER exposed-modules: GHCi.Run + GHCi.Debugger GHCi.CreateBCO GHCi.ObjLink GHCi.Signals ===================================== rts/Interpreter.c ===================================== @@ -243,9 +243,44 @@ allocate_NONUPD (Capability *cap, int n_words) return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words)); } -int rts_stop_next_breakpoint = 0; int rts_stop_on_exception = 0; +/* --------------------------------------------------------------------------- + * Enabling and disabling global single step mode + * ------------------------------------------------------------------------ */ + +/* A global toggle for single-step mode. + * Unlike `TSO_STOP_NEXT_BREAKPOINT`, which sets single-step mode per-thread, + * `rts_stop_next_breakpoint` globally enables single-step mode. If enabled, we + * will stop at the immediate next breakpoint regardless of what thread it is in. */ +int rts_stop_next_breakpoint = 0; + +void rts_enableStopNextBreakpointAll(void) +{ + rts_stop_next_breakpoint = 1; +} + +void rts_disableStopNextBreakpointAll(void) +{ + rts_stop_next_breakpoint = 0; +} + +/* --------------------------------------------------------------------------- + * Enabling and disabling per-thread single step mode + * ------------------------------------------------------------------------ */ + +void rts_enableStopNextBreakpoint(StgPtr tso) +{ + ((StgTSO *)tso)->flags |= TSO_STOP_NEXT_BREAKPOINT; +} + +void rts_disableStopNextBreakpoint(StgPtr tso) +{ + ((StgTSO *)tso)->flags &= ~TSO_STOP_NEXT_BREAKPOINT; +} + +/* -------------------------------------------------------------------------- */ + #if defined(INTERP_STATS) #define N_CODES 128 @@ -1250,7 +1285,7 @@ run_BCO: int arg8_cc; #endif StgArrBytes *breakPoints; - int returning_from_break; + int returning_from_break, stop_next_breakpoint; // the io action to run at a breakpoint StgClosure *ioAction; @@ -1280,6 +1315,13 @@ run_BCO: returning_from_break = cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT; + // check whether this thread is set to stop at the immediate next + // breakpoint -- either by the global `rts_stop_next_breakpoint` + // flag, or by the local `TSO_STOP_NEXT_BREAKPOINT` + stop_next_breakpoint = + rts_stop_next_breakpoint || + cap->r.rCurrentTSO->flags & TSO_STOP_NEXT_BREAKPOINT; + #if defined(PROFILING) cap->r.rCCCS = pushCostCentre(cap->r.rCCCS, (CostCentre*)BCO_LIT(arg8_cc)); @@ -1291,20 +1333,20 @@ run_BCO: { breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array); - // stop the current thread if either the - // "rts_stop_next_breakpoint" flag is true OR if the - // ignore count for this particular breakpoint is zero + // stop the current thread if either `stop_next_breakpoint` is + // true OR if the ignore count for this particular breakpoint is zero StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index]; - if (rts_stop_next_breakpoint == false && ignore_count > 0) + if (stop_next_breakpoint == false && ignore_count > 0) { // decrement and write back ignore count ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count; } - else if (rts_stop_next_breakpoint == true || ignore_count == 0) + else if (stop_next_breakpoint == true || ignore_count == 0) { // make sure we don't automatically stop at the // next breakpoint - rts_stop_next_breakpoint = false; + rts_stop_next_breakpoint = 0; + cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT; // allocate memory for a new AP_STACK, enough to // store the top stack frame plus an ===================================== rts/Interpreter.h ===================================== @@ -11,3 +11,8 @@ RTS_PRIVATE Capability *interpretBCO (Capability* cap); void interp_startup ( void ); void interp_shutdown ( void ); + +void rts_enableStopNextBreakpointAll ( void ); +void rts_disableStopNextBreakpointAll ( void ); +void rts_enableStopNextBreakpoint ( StgPtr ); +void rts_disableStopNextBreakpoint ( StgPtr ); ===================================== rts/RtsSymbols.c ===================================== @@ -906,7 +906,8 @@ extern char **environ; SymI_HasProto(revertCAFs) \ SymI_HasProto(RtsFlags) \ SymI_NeedsDataProto(rts_breakpoint_io_action) \ - SymI_NeedsDataProto(rts_stop_next_breakpoint) \ + SymI_NeedsDataProto(rts_enableStopNextBreakpointAll) \ + SymI_NeedsDataProto(rts_disableStopNextBreakpointAll) \ SymI_NeedsDataProto(rts_stop_on_exception) \ SymI_HasProto(stopTimer) \ SymI_HasProto(n_capabilities) \ ===================================== rts/include/rts/Constants.h ===================================== @@ -328,6 +328,12 @@ */ #define TSO_ALLOC_LIMIT 256 +/* + * Enables step-in mode for this thread -- it will stop at the immediate next + * breakpoint found in this thread. + */ +#define TSO_STOP_NEXT_BREAKPOINT 512 + /* * The number of times we spin in a spin lock before yielding (see * #3758). To tune this value, use the benchmark in #3758: run the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8844a0f930792082213d74db1c04520… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8844a0f930792082213d74db1c04520… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T25992] 42 commits: llvmGen: Fix built-in variable predicate
by Simon Peyton Jones (＠simonpj) 22 May '25

22 May '25

Simon Peyton Jones pushed to branch wip/T25992 at Glasgow Haskell Compiler / GHC Commits: 6e67fa08 by Ben Gamari at 2025-05-08T06:21:21-04:00 llvmGen: Fix built-in variable predicate Previously the predicate to identify LLVM builtin global variables was checking for `$llvm` rather than `@llvm` as it should. - - - - - a9d0a22c by Ben Gamari at 2025-05-08T06:21:22-04:00 llvmGen: Fix linkage of built-in arrays LLVM now insists that built-in arrays use Appending linkage, not Internal. Fixes #25769. - - - - - 9c6d2b1b by sheaf at 2025-05-08T06:22:11-04:00 Use mkTrAppChecked in ds_ev_typeable This change avoids violating the invariant of mkTrApp according to which the argument should not be a fully saturated function type. This ensures we don't return false negatives for type equality involving function types. Fixes #25998 - - - - - 75cadf81 by Ryan Hendrickson at 2025-05-08T06:22:55-04:00 haddock: Preserve indentation in multiline examples Intended for use with :{ :}, but doesn't look for those characters. Any consecutive lines with birdtracks will only have initial whitespace stripped up to the column of the first line. - - - - - fee9b351 by Cheng Shao at 2025-05-08T06:23:36-04:00 ci: re-enable chrome for wasm ghci browser tests Currently only firefox is enabled for wasm ghci browser tests, for some reason testing with chrome works on my machine but gets stuck on gitlab instance runners. This patch re-enables testing with chrome by passing `--no-sandbox`, since chrome sandboxing doesn't work in containers without `--cap-add=SYS_ADMIN`. - - - - - 282df905 by Vladislav Zavialov at 2025-05-09T03:18:25-04:00 Take subordinate 'type' specifiers into account This patch fixes multiple bugs (#22581, #25983, #25984, #25991) in name resolution of subordinate import lists. Bug #22581 ---------- In subordinate import lists, the use of the `type` namespace specifier used to be ignored. For example, this import statement was incorrectly accepted: import Prelude (Bool(type True)) Now it results in an error message: <interactive>:2:17: error: [GHC-51433] In the import of ‘Prelude’: a data type called ‘Bool’ is exported, but its subordinate item ‘True’ is not in the type namespace. Bug #25983 ---------- In subordinate import lists within a `hiding` clause, non-existent items led to a poor warning message with -Wdodgy-imports. Consider: import Prelude hiding (Bool(X)) The warning message for this import statement used to misreport the cause of the problem: <interactive>:3:24: warning: [GHC-56449] [-Wdodgy-imports] In the import of ‘Prelude’: an item called ‘Bool’ is exported, but it is a type. Now the warning message is correct: <interactive>:2:24: warning: [GHC-10237] [-Wdodgy-imports] In the import of ‘Prelude’: a data type called ‘Bool’ is exported, but it does not export any constructors or record fields called ‘X’. Bug #25984 ---------- In subordinate import lists within a `hiding` clause, non-existent items resulted in the entire import declaration being discarded. For example, this program was incorrectly accepted: import Prelude hiding (Bool(True,X)) t = True Now it results in an error message: <interactive>:2:5: error: [GHC-88464] Data constructor not in scope: True Bug #25991 ---------- In subordinate import lists, it was not possible to refer to a class method if there was an associated type of the same name: module M_helper where class C a b where type a # b (#) :: a -> b -> () module M where import M_helper (C((#))) This import declaration failed with: M.hs:2:28: error: [GHC-10237] In the import of ‘M_helper’: an item called ‘C’ is exported, but it does not export any children (constructors, class methods or field names) called ‘#’. Now it is accepted. Summary ------- The changes required to fix these bugs are almost entirely confined to GHC.Rename.Names. Other than that, there is a new error constructor BadImportNonTypeSubordinates with error code [GHC-51433]. Test cases: T22581a T22581b T22581c T22581d T25983a T25983b T25983c T25983d T25983e T25983f T25983g T25984a T25984b T25991a T25991b1 T25991b2 - - - - - 51b0ce8f by Simon Peyton Jones at 2025-05-09T03:19:07-04:00 Slighty improve `dropMisleading` Fix #26105, by upgrading the (horrible, hacky) `dropMisleading` function. This fix makes things a bit better but does not cure the underlying problem. - - - - - 7b2d1e6d by Simon Peyton Jones at 2025-05-11T03:24:47-04:00 Refine `noGivenNewtypeReprEqs` to account for quantified constraints This little MR fixes #26020. We are on the edge of completeness for newtype equalities (that doesn't change) but this MR makes GHC a bit more consistent -- and fixes the bug reported. - - - - - eaa8093b by Cheng Shao at 2025-05-11T03:25:28-04:00 wasm: mark freeJSVal as INLINE This patch marks `freeJSVal` as `INLINE` for the wasm backend. I noticed that the `freeJSVal` invocations are not inlined when inspecting STG/Cmm dumps of downstream libraries that use release build of the wasm backend. The performance benefit of inlining here is very modest, but so is the cost anyway; if you are using `freeJSVal` at all then you care about every potential chance to improve performance :) - - - - - eac196df by Cheng Shao at 2025-05-11T03:25:28-04:00 wasm: add zero length fast path for fromJSString This patch adds a zero length fast path for `fromJSString`; when marshaling a zero-length `JSString` we don't need to allocate an empty `ByteArray#` at all. - - - - - 652cba7e by Peng Fan at 2025-05-14T04:24:35-04:00 Add LoongArch NCG support Not supported before. - - - - - c01f4374 by Lin Runze at 2025-05-14T04:24:35-04:00 ci: Add LoongArch64 cross-compile CI for testing - - - - - ce6cf240 by Ben Gamari at 2025-05-14T04:25:18-04:00 rts/linker: Don't fail due to RTLD_NOW In !12264 we started using the NativeObj machinery introduced some time ago for loading of shared objects. One of the side-effects of this change is shared objects are now loaded eagerly (i.e. with `RTLD_NOW`). This is needed by NativeObj to ensure full visibility of the mappings of the loaded object, which is in turn needed for safe shared object unloading. Unfortunately, this change subtly regressed, causing compilation failures in some programs. Specifically, shared objects which refer to undefined symbols (e.g. which may be usually provided by either the executable image or libraries loaded via `dlopen`) will fail to load with eager binding. This is problematic as GHC loads all package dependencies while, e.g., evaluating TemplateHaskell splices. This results in compilation failures in programs depending upon (but not using at compile-time) packages with undefined symbol references. To mitigate this NativeObj now first attempts to load an object via eager binding, reverting to lazy binding (and disabling unloading) on failure. See Note [Don't fail due to RTLD_NOW]. Fixes #25943. - - - - - 88ee8bb5 by Sylvain Henry at 2025-05-14T04:26:15-04:00 Deprecate GHC.JS.Prim.Internal.Build (#23432) Deprecated as per CLC proposal 329 (https://github.com/haskell/core-libraries-committee/issues/329) - - - - - b4ed465b by Cheng Shao at 2025-05-14T04:26:57-04:00 libffi: update to 3.4.8 Bumps libffi submodule. - - - - - a3e71296 by Matthew Pickering at 2025-05-14T04:27:38-04:00 Remove leftover trace - - - - - 2d0ecdc6 by Cheng Shao at 2025-05-14T04:28:19-04:00 Revert "ci: re-enable chrome for wasm ghci browser tests" This reverts commit fee9b351fa5a35d5778d1252789eacaaf5663ae8. Unfortunately the chrome test jobs may still timeout on certain runners (e.g. OpenCape) for unknown reasons. - - - - - 3b3a5dec by Ben Gamari at 2025-05-15T16:10:01-04:00 Don't emit unprintable characters when printing Uniques When faced with an unprintable tag we now instead print the codepoint number. Fixes #25989. (cherry picked from commit e832b1fadee66e8d6dd7b019368974756f8f8c46) - - - - - e1ef8974 by Mike Pilgrem at 2025-05-16T16:09:14-04:00 Translate iff in Haddock documentation into everyday English - - - - - fd64667d by Vladislav Zavialov at 2025-05-20T03:25:08-04:00 Allow the 'data' keyword in import/export lists (#25899) This patch introduces the 'data' namespace specifier in import and export lists. The intended use is to import data constructors without their parent type constructors, e.g. import Data.Proxy as D (data Proxy) type DP = D.Proxy -- promoted data constructor Additionally, it is possible to use 'data' to explicitly qualify any data constructors or terms, incl. operators and field selectors import Prelude (Semigroup(data (<>))) import Data.Function (data (&)) import Data.Monoid (data Dual, data getDual) x = Dual "Hello" <> Dual "World" & getDual The implementation mostly builds on top of the existing logic for the 'type' and 'pattern' namespace specifiers, plus there are a few tweaks to how we generate suggestions in error messages. - - - - - acc86753 by Ben Gamari at 2025-05-20T03:25:51-04:00 compiler: Use field selectors when creating BCOs This makes it easier to grep for these fields. - - - - - 60a55fd7 by Ben Gamari at 2025-05-20T03:25:51-04:00 compiler: Clarify BCO size Previously the semantics and size of StgBCO was a bit unclear. Specifically, the `size` field was documented to contain the size of the bitmap whereas it was actually the size of the closure *and* bitmap. Additionally, it was not as clear as it could be that the bitmap was a full StgLargeBitmap with its own `size` field. - - - - - ac9fb269 by Simon Peyton Jones at 2025-05-20T09:19:04-04:00 Track rewriter sets more accurately in constraint solving This MR addresses #26003, by refactoring the arcane intricacies of Note [Equalities with incompatible kinds]. NB: now retitled to Note [Equalities with heterogeneous kinds]. and the main Note for this MR. In particular: * Abandon invariant (COERCION-HOLE) in Note [Unification preconditions] in GHC.Tc.Utils.Unify. * Abandon invariant (TyEq:CH)) in Note [Canonical equalities] in GHC.Tc.Types.Constraint. * Instead: add invariant (REWRITERS) to Note [Unification preconditions]: unify only if the constraint has an empty rewriter set. Implementation: * In canEqCanLHSFinish_try_unification, skip trying unification if there is a non-empty rewriter set. * To do this, make sure the rewriter set is zonked; do so in selectNextWorkItem, which also deals with prioritisation. * When a coercion hole is filled, kick out inert equalities that have that hole as a rewriter. It might now be unlocked and available to unify. * Remove the ad-hoc `ch_hetero_kind` field of `CoercionHole`. * In `selectNextWorkItem`, priorities equalities withan empty rewriter set. * Defaulting: see (DE6) in Note [Defaulting equalities] and Note [Limited defaulting in the ambiguity check] * Concreteness checks: there is some extra faff to try to get decent error messages when the FRR (representation-polymorphism) checks fail. In partiular, add a "When unifying..." explanation when the representation-polymorphism check arose from another constraint. - - - - - 86406f48 by Cheng Shao at 2025-05-20T09:19:47-04:00 rts: fix rts_clearMemory logic when sanity checks are enabled This commit fixes an RTS assertion failure when invoking rts_clearMemory with +RTS -DS. -DS implies -DZ which asserts that free blocks contain 0xaa as the designated garbage value. Also adds the sanity way to rts_clearMemory test to prevent future regression. Closes #26011. ChatGPT Codex automatically diagnosed the issue and proposed the initial patch in a single shot, given a GHC checkout and the following prompt: --- Someone is reporting the following error when attempting to use `rts_clearMemory` with the RTS option `-DS`: ``` test.wasm: internal error: ASSERTION FAILED: file rts/sm/Storage.c, line 1216 (GHC version 9.12.2.20250327 for wasm32_unknown_wasi) Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` What's the culprit? How do I look into this issue? --- I manually reviewed & revised the patch, tested and submitted it. - - - - - 7147370b by Cheng Shao at 2025-05-20T17:22:19-04:00 compiler: do not allocate strings in bytecode assembler This patch refactors the compiler to avoid allocating iserv buffers for BCONPtrStr at assemble-time. Now BCONPtrStr ByteStrings are recorded as a part of CompiledByteCode, and actual allocation only happens at link-time. This refactoring is necessary for adding bytecode serialization functionality, as explained by the revised comments in this commit. - - - - - a67db612 by Cheng Shao at 2025-05-20T17:22:19-04:00 compiler: make bc_strs serializable This commit makes the bc_strs field in CompiledByteCode serializable; similar to previous commit, we preserve the ByteString directly and defer the actual allocation to link-time, as mentioned in updated comment. - - - - - 5faf34ef by Cheng Shao at 2025-05-20T17:22:19-04:00 compiler: make bc_itbls serializable This commit makes bc_itbls in CompiledByteCode serializable. A dedicated ConInfoTable datatype has been added in ghci which is the recipe for dynamically making a datacon's info table, containing the payload of the MkConInfoTable iserv message. - - - - - 2abaf8c1 by Cheng Shao at 2025-05-20T17:22:19-04:00 compiler: remove FFIInfo bookkeeping in BCO This commit removes the bc_ffis field from CompiledByteCode completely, as well as all the related bookkeeping logic in GHC.StgToByteCode. bc_ffis is actually *unused* in the rest of GHC codebase! It is merely a list of FFIInfo, which is just a remote pointer of the libffi ffi_cif struct; once we allocate the ffi_cif struct and put its pointer in a CCALL instruction, we'll never free it anyway. So there is no point of bookkeeping. - - - - - adb9e4d2 by Cheng Shao at 2025-05-20T17:22:19-04:00 compiler: make FFIInfo serializable in BCO This commit makes all the FFIInfo needed in CCALL instructions serializable. Previously, when doing STG to BCO lowering, we would allocate a libffi ffi_cif struct and keep its remote pointer as FFIInfo; but actually we can just keep the type signature as FFIInfo and defer the actual allocation to link-time. - - - - - 200f401b by Cheng Shao at 2025-05-20T17:22:19-04:00 ghci: remove redundant NewBreakModule message This commit removes the redundant NewBreakModule message from ghci: it just allocates two strings! This functionality can be implemented with existing MallocStrings in one iserv call. - - - - - ddaadca6 by Cheng Shao at 2025-05-20T17:22:19-04:00 compiler: make breakpoint module name and unit id serializable This commit makes breakpoint module name and unit id serializable, in BRK_FUN instructions as well as ModBreaks. We can simply keep the module name and unit ids, and defer the buffer allocation to link time. - - - - - a0fde202 by Cheng Shao at 2025-05-20T17:22:19-04:00 compiler: remove unused newModule This commit removes the now unused newModule function from GHC. - - - - - 68c8f140 by Cheng Shao at 2025-05-20T17:22:19-04:00 compiler: add BCONPtrFS for interned top level string literals in BCO This commit adds BCONPtrFS as a BCO non-pointer literal kind, which has the same semantics of BCONPtrStr, except it contains a FastString instead of a ByteString. By using BCONPtrFS to represent top level string literals that are already FastString in the compilation pipeline, we enjoy the FastString interning logic and avoid allocating a bunch of redundant ByteStrings for the same FastStrings, especially when we lower the BRK_FUN instruction. - - - - - f2b532bc by Peng Fan at 2025-05-20T17:23:15-04:00 hadrian: enable GHCi for loongarch64 - - - - - 8ded2330 by kwxm at 2025-05-20T17:24:07-04:00 Fix bugs in `integerRecipMod` and `integerPowMod` This fixes #26017. * `integerRecipMod x 1` now returns `(# 1 | #)` for all x; previously it incorrectly returned `(# | () #)`, indicating failure. * `integerPowMod 0 e m` now returns `(# | () #)` for e<0 and m>1, indicating failure; previously it incorrectly returned `(# 0 | #)`. - - - - - c9abb87c by Andreas Klebinger at 2025-05-20T17:24:50-04:00 Specialise: Don't float out constraint components. It was fairly complex to do so and it doesn't seem to improve anything. Nofib allocations were unaffected as well. See also Historical Note [Floating dictionaries out of cases] - - - - - 202b201c by Andreas Klebinger at 2025-05-21T10:16:14-04:00 Interpreter: Add limited support for direct primop evaluation. This commit adds support for a number of primops directly to the interpreter. This avoids the indirection of going through the primop wrapper for those primops speeding interpretation of optimized code up massively. Code involving IntSet runs about 25% faster with optimized core and these changes. For core without breakpoints it's even more pronouced and I saw reductions in runtime by up to 50%. Running GHC itself in the interpreter was sped up by ~15% through this change. Additionally this comment does a few other related changes: testsuite: * Run foundation test in ghci and ghci-opt ways to test these primops. * Vastly expand the foundation test to cover all basic primops by comparing result with the result of calling the wrapper. Interpreter: * When pushing arguments for interpreted primops extend each argument to at least word with when pushing. This avoids some issues with big endian. We can revisit this if it causes performance issues. * Restructure the stack chunk check logic. There are now macros for read accesses which might cross stack chunk boundries and macros which omit the checks which are used when we statically know we access an address in the current stack chunk. - - - - - 67a177b4 by sheaf at 2025-05-21T10:17:04-04:00 QuickLook: do a shape test before unifying This commit ensures we do a shape test before unifying. This ensures we don't try to unify a TyVarTv with a non-tyvar, e.g. alpha[tyv] := Int On the way, we refactor simpleUnifyCheck: 1. Move the checkTopShape check into simpleUnifyCheck 2. Refactors simpleUnifyCheck to return a value of the new type SimpleUnifyResult type. Now, simpleUnifyCheck returns "can unify", "cannot unify" or "dunno" (with "cannot unify" being the new result it can return). Now: - touchabilityTest is included; it it fails we return "cannot unify" - checkTopShape now returns "cannot unify" instead of "dunno" upon failure 3. Move the call to simpleUnifyCheck out of checkTouchableTyVarEq. After that, checkTouchableTyVarEq becames a simple call to checkTyEqRhs, so we inline it. This allows the logic in canEqCanLHSFinish_try_unification to be simplified. In particular, we now avoid calling 'checkTopShape' twice. Two further changes suggested by Simon were also implemented: - In canEqCanLHSFinish, if checkTyEqRhs returns PuFail with 'do_not_prevent_rewriting', we now **continue with this constraint**. This allows us to use the constraint for rewriting. - checkTyEqRhs now has a top-level check to avoid flattening a tyfam app in a top-level equality of the form alpha ~ F tys, as this is going around in circles. This simplifies the implementation without any change in behaviour. Fixes #25950 Fixes #26030 - - - - - 4020972c by sheaf at 2025-05-21T10:17:04-04:00 FixedRuntimeRepError: omit unhelpful explanation This commit tweaks the FixedRuntimeRepError case of pprTcSolverReportMsg, to avoid including an explanation which refers to a type variable that appears nowhere else. For example, the old error message could look like the following: The pattern binding does not have a fixed runtime representation. Its type is: T :: TYPE R Cannot unify ‘R’ with the type variable ‘c0’ because the former is not a concrete ‘RuntimeRep’. With this commit, we now omit the last two lines, because the concrete type variable (here 'c0') does not appear in the type displayed to the user (here 'T :: TYPE R'). - - - - - 24b88182 by Simon Peyton Jones at 2025-05-21T15:41:09+01:00 Better redundant constraints for instance decls Addresses #25992 Draft for CI - - - - - 60c075f2 by Simon Peyton Jones at 2025-05-21T15:41:09+01:00 WIP on unsued constraints [skip ci] - - - - - a8b922eb by Simon Peyton Jones at 2025-05-22T17:43:59+01:00 Refactor tracking of unused givens [skipci] - - - - - 243 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Constants.hs - + compiler/GHC/CmmToAsm/LA64.hs - + compiler/GHC/CmmToAsm/LA64/CodeGen.hs - + compiler/GHC/CmmToAsm/LA64/Cond.hs - + compiler/GHC/CmmToAsm/LA64/Instr.hs - + compiler/GHC/CmmToAsm/LA64/Ppr.hs - + compiler/GHC/CmmToAsm/LA64/RegInfo.hs - + compiler/GHC/CmmToAsm/LA64/Regs.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs - + compiler/GHC/CmmToAsm/Reg/Linear/LA64.hs - compiler/GHC/CmmToAsm/Reg/Target.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Platform/LoongArch64.hs → compiler/GHC/Platform/LA64.hs - compiler/GHC/Platform/Regs.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - compiler/ghc.cabal.in - docs/users_guide/9.14.1-notes.rst - docs/users_guide/exts/explicit_namespaces.rst - docs/users_guide/exts/pattern_synonyms.rst - hadrian/bindist/config.mk.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Builders/RunTest.hs - libffi-tarballs - libraries/base/changelog.md - libraries/base/src/GHC/JS/Prim/Internal/Build.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs - libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - rts/Disassembler.c - rts/Interpreter.c - rts/PrimOps.cmm - rts/include/rts/Bytecodes.h - rts/include/rts/storage/Closures.h - rts/linker/LoadNativeObjPosix.c - rts/sm/Storage.h - testsuite/tests/bytecode/T22376/all.T - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/dependent/should_fail/T11471.stderr - testsuite/tests/diagnostic-codes/codes.stdout - testsuite/tests/driver/RecompExports/RecompExports1.stderr - testsuite/tests/driver/RecompExports/RecompExports4.stderr - testsuite/tests/ffi/should_run/all.T - + testsuite/tests/ghci/all.T - + testsuite/tests/ghci/ghci-mem-primops.hs - + testsuite/tests/ghci/ghci-mem-primops.script - + testsuite/tests/ghci/ghci-mem-primops.stdout - testsuite/tests/indexed-types/should_fail/T8227.stderr - testsuite/tests/indexed-types/should_fail/T9662.stderr - + testsuite/tests/lib/integer/T26017.hs - + testsuite/tests/lib/integer/T26017.stdout - testsuite/tests/lib/integer/all.T - testsuite/tests/lib/integer/integerRecipMod.hs - testsuite/tests/lib/integer/integerRecipMod.stdout - testsuite/tests/module/T21826.stderr - testsuite/tests/module/mod81.stderr - testsuite/tests/module/mod91.stderr - testsuite/tests/numeric/should_run/all.T - testsuite/tests/numeric/should_run/foundation.hs - testsuite/tests/numeric/should_run/foundation.stdout - testsuite/tests/partial-sigs/should_fail/T14040a.stderr - testsuite/tests/partial-sigs/should_fail/T14584.stderr - testsuite/tests/perf/should_run/ByteCodeAsm.hs - testsuite/tests/polykinds/T14172.stderr - testsuite/tests/polykinds/T14846.stderr - + testsuite/tests/rename/should_compile/T22581c.hs - + testsuite/tests/rename/should_compile/T22581c_helper.hs - + testsuite/tests/rename/should_compile/T22581d.script - + testsuite/tests/rename/should_compile/T22581d.stdout - + testsuite/tests/rename/should_compile/T25899a.hs - + testsuite/tests/rename/should_compile/T25899b.hs - + testsuite/tests/rename/should_compile/T25899c.hs - + testsuite/tests/rename/should_compile/T25899c_helper.hs - + testsuite/tests/rename/should_compile/T25899d.script - + testsuite/tests/rename/should_compile/T25899d.stdout - + testsuite/tests/rename/should_compile/T25983a.hs - + testsuite/tests/rename/should_compile/T25983a.stderr - + testsuite/tests/rename/should_compile/T25983b.hs - + testsuite/tests/rename/should_compile/T25983b.stderr - + testsuite/tests/rename/should_compile/T25983c.hs - + testsuite/tests/rename/should_compile/T25983c.stderr - + testsuite/tests/rename/should_compile/T25983d.hs - + testsuite/tests/rename/should_compile/T25983d.stderr - + testsuite/tests/rename/should_compile/T25983e.hs - + testsuite/tests/rename/should_compile/T25983e.stderr - + testsuite/tests/rename/should_compile/T25983f.hs - + testsuite/tests/rename/should_compile/T25983f.stderr - + testsuite/tests/rename/should_compile/T25983g.hs - + testsuite/tests/rename/should_compile/T25983g.stderr - + testsuite/tests/rename/should_compile/T25984a.hs - + testsuite/tests/rename/should_compile/T25984a.stderr - + testsuite/tests/rename/should_compile/T25984a_helper.hs - + testsuite/tests/rename/should_compile/T25991a.hs - + testsuite/tests/rename/should_compile/T25991a_helper.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T22581a.hs - + testsuite/tests/rename/should_fail/T22581a.stderr - + testsuite/tests/rename/should_fail/T22581a_helper.hs - + testsuite/tests/rename/should_fail/T22581b.hs - + testsuite/tests/rename/should_fail/T22581b.stderr - + testsuite/tests/rename/should_fail/T22581b_helper.hs - + testsuite/tests/rename/should_fail/T25899e1.hs - + testsuite/tests/rename/should_fail/T25899e1.stderr - + testsuite/tests/rename/should_fail/T25899e2.hs - + testsuite/tests/rename/should_fail/T25899e2.stderr - + testsuite/tests/rename/should_fail/T25899e3.hs - + testsuite/tests/rename/should_fail/T25899e3.stderr - + testsuite/tests/rename/should_fail/T25899e_helper.hs - + testsuite/tests/rename/should_fail/T25899f.hs - + testsuite/tests/rename/should_fail/T25899f.stderr - + testsuite/tests/rename/should_fail/T25899f_helper.hs - + testsuite/tests/rename/should_fail/T25984b.hs - + testsuite/tests/rename/should_fail/T25984b.stderr - + testsuite/tests/rename/should_fail/T25991b1.hs - + testsuite/tests/rename/should_fail/T25991b1.stderr - + testsuite/tests/rename/should_fail/T25991b2.hs - + testsuite/tests/rename/should_fail/T25991b2.stderr - + testsuite/tests/rename/should_fail/T25991b_helper.hs - testsuite/tests/rename/should_fail/T9006.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/rep-poly/RepPolyArgument.stderr - testsuite/tests/rep-poly/RepPolyBackpack1.stderr - testsuite/tests/rep-poly/RepPolyBinder.stderr - testsuite/tests/rep-poly/RepPolyDoBind.stderr - testsuite/tests/rep-poly/RepPolyDoBody1.stderr - testsuite/tests/rep-poly/RepPolyDoBody2.stderr - testsuite/tests/rep-poly/RepPolyLeftSection2.stderr - testsuite/tests/rep-poly/RepPolyMagic.stderr - testsuite/tests/rep-poly/RepPolyMcBind.stderr - testsuite/tests/rep-poly/RepPolyMcBody.stderr - testsuite/tests/rep-poly/RepPolyMcGuard.stderr - testsuite/tests/rep-poly/RepPolyNPlusK.stderr - testsuite/tests/rep-poly/RepPolyPatBind.stderr - testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr - testsuite/tests/rep-poly/RepPolyRightSection.stderr - testsuite/tests/rep-poly/RepPolyRule1.stderr - testsuite/tests/rep-poly/RepPolyTuple.stderr - testsuite/tests/rep-poly/RepPolyTuple4.stderr - testsuite/tests/rep-poly/RepPolyTupleSection.stderr - testsuite/tests/rep-poly/RepPolyWrappedVar.stderr - testsuite/tests/rep-poly/T11473.stderr - testsuite/tests/rep-poly/T12709.stderr - testsuite/tests/rep-poly/T12973.stderr - testsuite/tests/rep-poly/T13233.stderr - testsuite/tests/rep-poly/T13929.stderr - testsuite/tests/rep-poly/T14561.stderr - testsuite/tests/rep-poly/T14561b.stderr - testsuite/tests/rep-poly/T17817.stderr - testsuite/tests/rep-poly/T19615.stderr - testsuite/tests/rep-poly/T19709b.stderr - testsuite/tests/rep-poly/T21906.stderr - testsuite/tests/rep-poly/T23903.stderr - testsuite/tests/rep-poly/UnliftedNewtypesCoerceFail.stderr - testsuite/tests/rts/all.T - testsuite/tests/simplCore/should_compile/simpl017.stderr - testsuite/tests/typecheck/no_skolem_info/T14040.stderr - testsuite/tests/typecheck/should_compile/T25266a.stderr - + testsuite/tests/typecheck/should_compile/T26020.hs - + testsuite/tests/typecheck/should_compile/T26020a.hs - + testsuite/tests/typecheck/should_compile/T26020a_help.hs - + testsuite/tests/typecheck/should_compile/T26030.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T16204c.stderr - + testsuite/tests/typecheck/should_fail/T25950.hs - + testsuite/tests/typecheck/should_fail/T25950.stderr - + testsuite/tests/typecheck/should_fail/T26015.hs - + testsuite/tests/typecheck/should_fail/T26015.stderr - testsuite/tests/typecheck/should_fail/T7696.stderr - testsuite/tests/typecheck/should_fail/T8603.stderr - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/typecheck/should_run/T25998.hs - + testsuite/tests/typecheck/should_run/T25998.stdout - testsuite/tests/typecheck/should_run/all.T - utils/check-exact/ExactPrint.hs - utils/genprimopcode/Main.hs - utils/genprimopcode/Syntax.hs - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs - utils/haddock/haddock-library/test/Documentation/Haddock/ParserSpec.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/379158f739fc50273fdf96c0f6bfde… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/379158f739fc50273fdf96c0f6bfde… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/top-level-bcos-tag] rts: Case continuation BCOs
by Rodrigo Mesquita (＠alt-romes) 22 May '25

22 May '25

Rodrigo Mesquita pushed to branch wip/romes/top-level-bcos-tag at Glasgow Haskell Compiler / GHC Commits: 5cb4a42f by Rodrigo Mesquita at 2025-05-22T14:35:38+01:00 rts: Case continuation BCOs This commit introduces the `stg_CASE_CONT_BCO` info table, which is identical to `stg_BCO` and shares the same closure type (== BCO). It changes the bytecode generator to always use `stg_CASE_CONT_BCO_info` when constructing case continuation BCOs, and remain using `stg_BCO` otherwise. This allows us to distinguish at runtime case continuation BCOs from other BCOs. In particular, this is relevant because, unlike other BCOs, the code of a case continuation BCO may refer to variables in its parent's stack frame (ie non-local variables), and therefore its frame position on the stack cannot be changed in isolation. The full motivation and details are in Note [Case continuation BCOs]. Towards #26042 - - - - - 16 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/StgToByteCode.hs - libraries/base/src/GHC/Exts.hs - libraries/ghc-internal/src/GHC/Internal/Exts.hs - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/ResolvedBCO.hs - rts/Interpreter.c - rts/PrimOps.cmm - rts/Printer.c - rts/RtsSymbols.c - rts/StgMiscClosures.cmm - rts/include/stg/MiscClosures.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3872,12 +3872,13 @@ primop MkApUpd0_Op "mkApUpd0#" GenPrimOp with out_of_line = True -primop NewBCOOp "newBCO#" GenPrimOp - ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #) - { @'newBCO#' instrs lits ptrs arity bitmap@ creates a new bytecode object. The +primop NewBCOOp "newBCO2#" GenPrimOp + Int8# -> ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #) + { @'newBCO2#' is_case_cont instrs lits ptrs arity bitmap@ creates a new bytecode object. The resulting object encodes a function of the given arity with the instructions encoded in @instrs@, and a static reference table usage bitmap given by - @bitmap@. } + @bitmap@. The @is_case_cont@ boolean indicates whether the BCO is a case + continuation (see Note [Case continuation BCOs]) } with effect = ReadWriteEffect out_of_line = True ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -85,7 +85,7 @@ bcoFreeNames :: UnlinkedBCO -> UniqDSet Name bcoFreeNames bco = bco_refs bco `uniqDSetMinusUniqSet` mkNameSet [unlinkedBCOName bco] where - bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs) + bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs _) = unionManyUniqDSets ( mkUniqDSet [ n | BCOPtrName n <- elemsFlatBag ptrs ] : mkUniqDSet [ n | BCONPtrItbl n <- elemsFlatBag nonptrs ] : @@ -236,7 +236,8 @@ assembleBCO platform , protoBCOInstrs = instrs , protoBCOBitmap = bitmap , protoBCOBitmapSize = bsize - , protoBCOArity = arity }) = do + , protoBCOArity = arity + , protoBCOIsCaseCont = isCC }) = do -- pass 1: collect up the offsets of the local labels. let initial_offset = 0 @@ -266,7 +267,7 @@ assembleBCO platform let !insns_arr = mkBCOByteArray $ final_isn_array !bitmap_arr = mkBCOByteArray $ mkBitmapArray bsize bitmap - ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSmallArray final_lit_array) (fromSmallArray final_ptr_array) + ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSmallArray final_lit_array) (fromSmallArray final_ptr_array) isCC -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive -- objects, since they might get run too early. Disable this until ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -53,7 +53,8 @@ data ProtoBCO a -- what the BCO came from, for debugging only protoBCOExpr :: Either [CgStgAlt] CgStgRhs, -- malloc'd pointers - protoBCOFFIs :: [FFIInfo] + protoBCOFFIs :: [FFIInfo], + protoBCOIsCaseCont :: !Bool -- See Note [Case continuation BCOs] } -- | A local block label (e.g. identifying a case alternative). ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -59,7 +59,7 @@ linkBCO -> UnlinkedBCO -> IO ResolvedBCO linkBCO interp pkgs_loaded le bco_ix - (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do + (UnlinkedBCO _ arity insns bitmap lits0 ptrs0 isCC) = 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 :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (elemsFlatBag lits0) @@ -69,7 +69,7 @@ linkBCO interp pkgs_loaded le bco_ix insns bitmap (mkBCOByteArray lits') - (addListToSS emptySS ptrs)) + (addListToSS emptySS ptrs) isCC) lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word lookupLiteral interp pkgs_loaded le ptr = case ptr of ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -167,14 +167,109 @@ newtype ItblPtr = ItblPtr (RemotePtr Heap.StgInfoTable) newtype AddrPtr = AddrPtr (RemotePtr ()) deriving (NFData) +{- +-------------------------------------------------------------------------------- +-- * Byte Code Objects (BCOs) +-------------------------------------------------------------------------------- + +Note [Case continuation BCOs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +A stack with a BCO stack frame at the top looks like: + + (an StgBCO) + | ... | +---> +---------[1]--+ + +------------------+ | | info_tbl_ptr | ------+ + | OTHER FRAME | | +--------------+ | + +------------------+ | | StgArrBytes* | <--- the byte code + | ... | | +--------------+ | + +------------------+ | | ... | | + | fvs1 | | | + +------------------+ | | + | ... | | (StgInfoTable) | + +------------------+ | +----------+ <---+ + | args1 | | | ... | + +------------------+ | +----------+ + | some StgBCO* | -----+ | type=BCO | + +------------------+ +----------+ + Sp | stg_apply_interp | -----+ | ... | + +------------------+ | + | + | (StgInfoTable) + +----> +--------------+ + | ... | + +--------------+ + | type=RET_BCO | + +--------------+ + | ... | + + +The byte code for a BCO heap object makes use of arguments and free variables +which can typically be found within the BCO stack frame. In the code, these +variables are referenced via a statically known stack offset (tracked using +`BCEnv` in `StgToByteCode`). + +However, in /case continuation/ BCOs, the code may additionally refer to free +variables that are outside of that BCO's stack frame -- some free variables of a +case continuation BCO may only be found in the stack frame of a parent BCO. + +Yet, references to these out-of-frame variables are also done in terms of stack +offsets. Thus, they rely on the position of /another frame/ to be fixed. (See +Note [PUSH_L underflow] for more information about references to previous +frames and nested BCOs) + +This makes case continuation BCOs special: unlike normal BCOs, case cont BCO +frames cannot be moved on the stack independently from their parent BCOs. + +In order to be able to distinguish them at runtime, the code generator will use +distinct info table pointers for their closures, even though they will have the +same structure on the heap (StgBCO). Specifically: + + - Normal BCOs are always headed by the `stg_BCO_info` pointer. + - Case continuation BCOs are always headed by the `stg_CASE_CONT_BCO_info` pointer. + +A primary reason why we need to distinguish these two cases is to know where we +can insert a debugger step-out frame (`stg_stop_after_ret_frame`). In +particular, because case cont BCOs may refer to the parent frame, we must not +insert step-out frames between a case cont BCO and its parent. +See Note [Debugger: Step-out] for further details. + +As an example, consider the following, where `y` is free in the case alternatives: + + f x y = case x of + True -> y - 1 + False -> y + 1 :: Int + +While interpreting f, the args x and y will be on the stack as part of f's frame. +In its body, a case continuation BCO is pushed (PUSH_ALTS) and then `x` is +entered to be evaluated. Upon entering `x`, the stack would look something like: + + <f arg 2> + <f arg 1> + ... + <Case continuation BCO Frame> + +We cannot insert a step out frame in between: + + + <f arg 2> + <f arg 1> + ... + <inserted step-out frame> <--- BAD! Breaks stack offsets in the case cont. + <Case continuation BCO Frame> + +Instead, we must traverse until the parent BCO and insert the step-out frame before it instead. +-} + data UnlinkedBCO = UnlinkedBCO { unlinkedBCOName :: !Name, unlinkedBCOArity :: {-# UNPACK #-} !Int, - unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns - unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap + unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns + unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap unlinkedBCOLits :: !(FlatBag BCONPtr), -- non-ptrs - unlinkedBCOPtrs :: !(FlatBag BCOPtr) -- ptrs + unlinkedBCOPtrs :: !(FlatBag BCOPtr), -- ptrs + unlinkedBCOIsCaseCont :: !Bool -- See Note [Case continuation BCOs] } instance NFData UnlinkedBCO where @@ -227,10 +322,11 @@ seqCgBreakInfo CgBreakInfo{..} = rnf cgb_resty instance Outputable UnlinkedBCO where - ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs) + ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs pi) = sep [text "BCO", ppr nm, text "with", ppr (sizeFlatBag lits), text "lits", - ppr (sizeFlatBag ptrs), text "ptrs" ] + ppr (sizeFlatBag ptrs), text "ptrs", + ppr pi, text "is_pos_indep"] instance Outputable CgBreakInfo where ppr info = text "CgBreakInfo" <+> ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -253,7 +253,11 @@ mkProtoBCO -> Int -- ^ arity -> WordOff -- ^ bitmap size -> [StgWord] -- ^ bitmap - -> Bool -- ^ True <=> is a return point, rather than a function + -> Bool -- ^ True <=> it's a case continuation, rather than a function + -- Used for + -- (A) Stack check collision and + -- (B) Mark the BCO wrt whether it contains non-local stack + -- references. See Note [Case continuation BCOs]. -> [FFIInfo] -> ProtoBCO Name mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis @@ -264,7 +268,8 @@ mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bit protoBCOBitmapSize = fromIntegral bitmap_size, protoBCOArity = arity, protoBCOExpr = origin, - protoBCOFFIs = ffis + protoBCOFFIs = ffis, + protoBCOIsCaseCont = is_ret } where #if MIN_VERSION_rts(1,0,3) @@ -353,6 +358,9 @@ schemeTopBind (id, rhs) -- Park the resulting BCO in the monad. Also requires the -- name of the variable to which this value was bound, -- so as to give the resulting BCO a name. +-- +-- The resulting ProtoBCO expects the free variables and the function arguments +-- to be in the stack directly before it. schemeR :: [Id] -- Free vars of the RHS, ordered as they -- will appear in the thunk. Empty for -- top-level things, which have no free vars. @@ -391,6 +399,8 @@ schemeR_wrk fvs nm original_body (args, body) -- them unlike constructor fields. szsb_args = map (wordsToBytes platform . idSizeW platform) all_args sum_szsb_args = sum szsb_args + -- Make a stack offset for each argument or free var -- they should + -- appear contiguous in the stack, in order. p_init = Map.fromList (zip all_args (mkStackOffsets 0 szsb_args)) -- make the arg bitmap @@ -1401,7 +1411,7 @@ Note [unboxed tuple bytecodes and tuple_BCO] tupleBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name tupleBCO platform args_info args = mkProtoBCO platform Nothing invented_name body_code (Left []) - 0{-no arity-} bitmap_size bitmap False{-is alts-} + 0{-no arity-} bitmap_size bitmap False{-not alts-} where {- The tuple BCO is never referred to by name, so we can get away @@ -1422,7 +1432,7 @@ tupleBCO platform args_info args = primCallBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name primCallBCO platform args_info args = mkProtoBCO platform Nothing invented_name body_code (Left []) - 0{-no arity-} bitmap_size bitmap False{-is alts-} + 0{-no arity-} bitmap_size bitmap False{-not alts-} where {- The primcall BCO is never referred to by name, so we can get away ===================================== libraries/base/src/GHC/Exts.hs ===================================== @@ -26,12 +26,12 @@ module GHC.Exts -- ** Legacy interface for arrays of arrays module GHC.Internal.ArrayArray, -- * Primitive operations - {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-} + {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 10.14", "These symbols should be imported from ghc-internal instead if needed."] #-} Prim.BCO, {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-} Prim.mkApUpd0#, {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-} - Prim.newBCO#, + IExts.newBCO#, module GHC.Prim, module GHC.Prim.Ext, -- ** Running 'RealWorld' state thread @@ -119,7 +119,7 @@ module GHC.Exts maxTupleSize ) where -import GHC.Internal.Exts +import GHC.Internal.Exts hiding ( newBCO# ) import GHC.Internal.ArrayArray import GHC.Prim hiding ( coerce @@ -132,7 +132,7 @@ import GHC.Prim hiding , isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned# -- deprecated - , BCO, mkApUpd0#, newBCO# + , BCO, mkApUpd0# -- Don't re-export vector FMA instructions , fmaddFloatX4# @@ -256,8 +256,10 @@ import GHC.Prim hiding , minWord8X32# , minWord8X64# ) +import qualified GHC.Internal.Exts as IExts + ( newBCO# ) import qualified GHC.Prim as Prim - ( BCO, mkApUpd0#, newBCO# ) + ( BCO, mkApUpd0# ) import GHC.Prim.Ext ===================================== libraries/ghc-internal/src/GHC/Internal/Exts.hs ===================================== @@ -163,6 +163,9 @@ module GHC.Internal.Exts -- * The maximum tuple size maxTupleSize, + + -- * Interpreter + newBCO# ) where import GHC.Internal.Prim hiding ( coerce, dataToTagSmall#, dataToTagLarge#, whereFrom# ) @@ -469,3 +472,18 @@ resizeSmallMutableArray# arr0 szNew a s0 = -- accessible\" by word. considerAccessible :: Bool considerAccessible = True + +-------------------------------------------------------------------------------- +-- Interpreter + +{-| +@'newBCO#' instrs lits ptrs arity bitmap@ creates a new bytecode object. The +resulting object encodes a function of the given arity with the instructions +encoded in @instrs@, and a static reference table usage bitmap given by +@bitmap@. + +Note: Case continuation BCOs, with non-local stack references, must be +constructed using @'newBCO2#' 1@ instead. See Note [Case continuation BCOs]. +-} +newBCO# :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #) +newBCO# b1 b2 a1 i1 b3 s = newBCO2# (intToInt8# 0#) b1 b2 a1 i1 b3 s ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -87,11 +87,11 @@ linkBCO' arr ResolvedBCO{..} = do literals_barr = barr (getBCOByteArray resolvedBCOLits) PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs + let is_case_cont | resolvedBCOIsCaseCont = intToInt8# 1# + | otherwise = intToInt8# 0# IO $ \s -> case unsafeFreezeArray# marr s of { (# s, arr #) -> - case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io -> - io s - }} + newBCO2# is_case_cont insns_barr literals_barr arr arity# bitmap_barr s } -- we recursively link any sub-BCOs while making the ptrs array ===================================== libraries/ghci/GHCi/ResolvedBCO.hs ===================================== @@ -45,7 +45,8 @@ data ResolvedBCO resolvedBCOBitmap :: BCOByteArray Word, -- ^ bitmap resolvedBCOLits :: BCOByteArray Word, -- ^ non-ptrs - subword sized entries still take up a full (host) word - resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr) -- ^ ptrs + resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr), -- ^ ptrs + resolvedBCOIsCaseCont :: !Bool -- ^ See Note [Case continuation BCOs] } deriving (Generic, Show) @@ -86,7 +87,8 @@ instance Binary ResolvedBCO where put resolvedBCOBitmap put resolvedBCOLits put resolvedBCOPtrs - get = ResolvedBCO <$> get <*> get <*> get <*> get <*> get <*> get + put resolvedBCOIsCaseCont + get = ResolvedBCO <$> get <*> get <*> get <*> get <*> get <*> get <*> get -- See Note [BCOByteArray serialization] instance (Binary a, Storable a, IArray UArray a) => Binary (BCOByteArray a) where ===================================== rts/Interpreter.c ===================================== @@ -203,14 +203,14 @@ PUSH_L instruction. |---------| | BCO_1 | -<-┐ -|---------| +|---------| | ......... | |---------| | PUSH_L <n> | BCO_N | ->-┘ |---------| Here BCO_N is syntactically nested within the code for BCO_1 and will result -in code that references the prior stack frame of BCO_1 for some of it's local +in code that references the prior stack frame of BCO_1 for some of its local variables. If a stack overflow happens between the creation of the stack frame for BCO_1 and BCO_N the RTS might move BCO_N to a new stack chunk while leaving BCO_1 in place, invalidating a simple offset based reference to the outer stack @@ -524,14 +524,35 @@ interpretBCO (Capability* cap) // // We have a BCO application to perform. Stack looks like: // - // | .... | - // +---------------+ - // | arg1 | - // +---------------+ - // | BCO | - // +---------------+ - // Sp | RET_BCO | - // +---------------+ + // + // (an StgBCO) + // +---> +---------[1]--+ + // | | stg_BCO_info | ------+ + // | +--------------+ | + // | | StgArrBytes* | <--- the byte code + // | ... | | +--------------+ | + // +------------------+ | | ... | | + // | fvs1 | | | + // +------------------+ | | + // | ... | | (StgInfoTable) | + // +------------------+ | +----------+ <---+ + // | args1 | | | ... | + // +------------------+ | +----------+ + // | some StgBCO* | -----+ | type=BCO | + // +------------------+ +----------+ + // Sp | stg_apply_interp | -----+ | ... | + // +------------------+ | + // | + // | (StgInfoTable) + // +----> +--------------+ + // | ... | + // +--------------+ + // | type=RET_BCO | + // +--------------+ + // | ... | + // + // [1] An StgBCO's info table pointer may also be stg_CASE_CONT_BCO_info. + // See Note [Case continuation BCOs]. // else if (SpW(0) == (W_)&stg_apply_interp_info) { obj = UNTAG_CLOSURE((StgClosure *)ReadSpW(1)); @@ -1500,7 +1521,7 @@ run_BCO: // Here we make sure references we push are tagged. // See Note [CBV Functions and the interpreter] in Info.hs - //Safe some memory reads if we already have a tag. + //Save some memory reads if we already have a tag. if(GET_CLOSURE_TAG(tagged_obj) == 0) { StgClosure *obj = UNTAG_CLOSURE(tagged_obj); switch ( get_itbl(obj)->type ) { ===================================== rts/PrimOps.cmm ===================================== @@ -55,6 +55,7 @@ import CLOSURE stg_AP_STACK_info; import CLOSURE stg_AP_info; import CLOSURE stg_ARR_WORDS_info; import CLOSURE stg_BCO_info; +import CLOSURE stg_CASE_CONT_BCO_info; import CLOSURE stg_C_FINALIZER_LIST_info; import CLOSURE stg_DEAD_WEAK_info; import CLOSURE stg_END_STM_WATCH_QUEUE_closure; @@ -2434,7 +2435,8 @@ stg_deRefStablePtrzh ( P_ sp ) Bytecode object primitives ------------------------------------------------------------------------- */ -stg_newBCOzh ( P_ instrs, +stg_newBCO2zh ( CBool is_case_cont, + P_ instrs, P_ literals, P_ ptrs, W_ arity, @@ -2449,7 +2451,16 @@ stg_newBCOzh ( P_ instrs, bco = Hp - bytes + WDS(1); // No memory barrier necessary as this is a new allocation. - SET_HDR(bco, stg_BCO_info, CCS_MAIN); + if (is_case_cont > 0) { + /* Uses stg_CASE_CONT_BCO_info to construct the BCO frame (rather than stg_BCO_info). + * Case continuations may contain non-local references to parent frames. The distinct info table + * tag allows the RTS to identify such non-local frames. + * See Note [Case continuation BCOs] + */ + SET_HDR(bco, stg_CASE_CONT_BCO_info, CCS_MAIN); + } else { + SET_HDR(bco, stg_BCO_info, CCS_MAIN); + } StgBCO_instrs(bco) = instrs; StgBCO_literals(bco) = literals; ===================================== rts/Printer.c ===================================== @@ -690,6 +690,8 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) debugBelch("stg_ctoi_V_info" ); } else if (c == (StgWord)&stg_BCO_info) { debugBelch("stg_BCO_info" ); + } else if (c == (StgWord)&stg_CASE_CONT_BCO_info) { + debugBelch("stg_CASE_CONT_BCO_info" ); } else if (c == (StgWord)&stg_apply_interp_info) { debugBelch("stg_apply_interp_info" ); } else if (c == (StgWord)&stg_ret_t_info) { ===================================== rts/RtsSymbols.c ===================================== @@ -639,7 +639,7 @@ extern char **environ; SymI_HasDataProto(stg_copySmallMutableArrayzh) \ SymI_HasDataProto(stg_casSmallArrayzh) \ SymI_HasDataProto(stg_copyArray_barrier) \ - SymI_HasDataProto(stg_newBCOzh) \ + SymI_HasDataProto(stg_newBCO2zh) \ SymI_HasDataProto(stg_newByteArrayzh) \ SymI_HasDataProto(stg_casIntArrayzh) \ SymI_HasDataProto(stg_casInt8Arrayzh) \ ===================================== rts/StgMiscClosures.cmm ===================================== @@ -464,6 +464,12 @@ INFO_TABLE_RET( stg_dead_thread, RET_SMALL, /* ---------------------------------------------------------------------------- Entry code for a BCO + + `stg_BCO` and `stg_CASE_CONT_BCO` distinguish between a BCO that refers to + non-local variables in its code (using a stack offset) and those that do not. + Only case-continuation BCOs should use non-local variables. + Otherwise, `stg_BCO` and `stg_CASE_CONT_BCO` behave the same. + See Note [Case continuation BCOs]. ------------------------------------------------------------------------- */ INFO_TABLE_FUN( stg_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO ) @@ -478,6 +484,15 @@ INFO_TABLE_FUN( stg_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO ) jump stg_yield_to_interpreter []; } +INFO_TABLE_FUN( stg_CASE_CONT_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO ) +{ + /* Exactly as for stg_BCO */ + Sp_adj(-2); + Sp(1) = R1; + Sp(0) = stg_apply_interp_info; + jump stg_yield_to_interpreter []; +} + /* ---------------------------------------------------------------------------- Info tables for indirections. ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -180,6 +180,7 @@ RTS_ENTRY(stg_BLOCKING_QUEUE_CLEAN); RTS_ENTRY(stg_BLOCKING_QUEUE_DIRTY); RTS_FUN(stg_BCO); +RTS_FUN(stg_CASE_CONT_BCO); RTS_ENTRY(stg_EVACUATED); RTS_ENTRY(stg_WEAK); RTS_ENTRY(stg_DEAD_WEAK); @@ -577,7 +578,7 @@ RTS_FUN_DECL(stg_deRefWeakzh); RTS_FUN_DECL(stg_runRWzh); -RTS_FUN_DECL(stg_newBCOzh); +RTS_FUN_DECL(stg_newBCO2zh); RTS_FUN_DECL(stg_mkApUpd0zh); RTS_FUN_DECL(stg_retryzh); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5cb4a42f690d13d3f1424913691be55… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5cb4a42f690d13d3f1424913691be55… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/ghci-multiple-home-units] 4 commits: Add testcases for GHCi multiple home units
by Hannes Siebenhandl (＠fendor) 22 May '25

22 May '25

Hannes Siebenhandl pushed to branch wip/fendor/ghci-multiple-home-units at Glasgow Haskell Compiler / GHC Commits: 01436040 by fendor at 2025-05-21T15:24:16+02:00 Add testcases for GHCi multiple home units Adds the following testcases: * Evaluate code with a single home unit using 'initMulti' initialisation logic * More complicated testcase with multiple home units, testing reload logic and code evaluation. - - - - - 6b9fa620 by fendor at 2025-05-21T15:24:16+02:00 Make GHCi commands compatible with multiple home units === Design We enable all GHCi features that were previously guarded by the `inMulti` option. GHCi supported multiple home units up to a certain degree for quite a while now. The supported feature set was limited, due to a design impasse: One of the home units must be "active", e.g., there must be one `HomeUnit` whose `UnitId` is "active" which is returned when calling ```haskell do hscActiveUnitId <$> getSession ``` This makes sense in a GHC session, since you are always compiling a particular Module, but it makes less intuitive sense in an interactive session. Given an expression to evaluate, we can't easily tell in which "context" the expression should be parsed, typechecked and evaluated. That's why initially, most of GHCi features, except for `:reload`ing were disabled if the GHCi session had more than one `HomeUnitEnv`. We lift this restriction, enabling all features of GHCi for the multiple home unit case. To do this, we fundamentally change the `HomeUnitEnv` graph to be multiple home unit first. Instead of differentiating the case were we have a single home unit and multiple, we now always set up a multiple home unit session that scales seamlessly to an arbitrary amount of home units. We introduce two new `HomeUnitEnv`s that are always added to the `HomeUnitGraph`. They are: The "interactive-ghci", called the `interactiveGhciUnit`, contains the same `DynFlags` that are used by the `InteractiveContext` for interactive evaluation of expressions. This `HomeUnitEnv` is only used on the prompt of GHCi, so we may refer to it as "interactive-prompt" unit. See Note [Relation between the `InteractiveContext` and `interactiveGhciUnitId`] for discussing its role. And the "interactive-session"", called `interactiveSessionUnit` or `interactiveSessionUnitId`, which is used for loading Scripts into GHCi that are not `Target`s of any home unit, via `:load` or `:add`. Both of these "interactive" home units depend on all other `HomeUnitEnv`s that are passed as arguments on the cli. Additionally, the "interactive-ghci" unit depends on `interactive-session`. We always evaluate expressions in the context of the "interactive-ghci" session. Since "interactive-ghci" depends on all home units, we can import any `Module` from the other home units with ease. As we have a clear `HomeUnitGraph` hierarchy, we can set `interactiveGhciUnitId` as the active home unit for the full duration of the GHCi session. In GHCi, we always set `interactiveGhciUnitId` to be the currently active home unit. === Implementation Details Given this design idea, the implementation is relatively straight forward. The core insight is that a `ModuleName` is not sufficient to identify a `Module` in the `HomeUnitGraph`. Thus, large parts of the PR is simply about refactoring usages of `ModuleName` to prefer `Module`, which has a `Unit` attached and is unique over the `HomeUnitGraph`. Consequentially, most usages of `lookupHPT` are likely to be incorrect and have been replaced by `lookupHugByModule` which is keyed by a `Module`. In `GHCi/UI.hs`, we make sure there is only one location where we are actually translating `ModuleName` to a `Module`: * `lookupQualifiedModuleName` If a `ModuleName` is ambiguous, we detect this and report it to the user. To avoid repeated lookups of `ModuleName`s, we store the `Module` in the `InteractiveImport`, which additionally simplifies the interface loading. A subtle detail is that the `DynFlags` of the `InteractiveContext` are now stored both in the `HomeUnitGraph` and in the `InteractiveContext`. In UI.hs, there are multiple code paths where we are careful to update the `DynFlags` in both locations. Most importantly in `addToProgramDynFlags`. --- There is one metric increase in this commit: ------------------------- Metric Increase: T4029 ------------------------- It is an increase from 14.4 MB to 16.1 MB (+11.8%) which sounds like a pretty big regression at first. However, we argue this increase is solely caused by using more data structures for managing multiple home units in the GHCi session. In particular, due to the design decision of using three home units, the base memory usage increases... but by how much? A big contributor is the `UnitState`, of which we have three now, which on its own 260 KB per instance. That makes an additional memory usage of 520 KB, already explaining a third of the overall memory usage increase. Then we store more elements in the `HomeUnitGraph`, we have more `HomeUnitEnv` entries, etc... While we didn't chase down each byte, we looked at the memory usage over time for both `-hi` and `-hT` profiles and can say with confidence while the memory usage increased slightly, we did not introduce any space leak, as the graph looks almost identical as the memory usage graph of GHC HEAD. - - - - - 26f40012 by fendor at 2025-05-22T13:42:35+02:00 Fixup: impl - - - - - 9449adfd by fendor at 2025-05-22T14:51:22+02:00 FIXME: test - - - - - 133 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Types/Name/Ppr.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/Types.hs - ghc/GHCi/UI.hs - ghc/GHCi/UI/Exception.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - ghc/Main.hs - testsuite/driver/testlib.py - + testsuite/tests/driver/T706.stderr - testsuite/tests/driver/T8526/T8526.stdout - testsuite/tests/driver/fat-iface/fat014.stdout - testsuite/tests/driver/multipleHomeUnits/multiGHCi.stderr - testsuite/tests/ghc-api/T6145.hs - testsuite/tests/ghc-api/annotations-literals/literals.hs - testsuite/tests/ghc-api/annotations-literals/parsed.hs - testsuite/tests/ghc-api/apirecomp001/myghc.hs - testsuite/tests/ghc-api/fixed-nodes/T1.hs - + testsuite/tests/ghci.debugger/scripts/break031/Makefile - + testsuite/tests/ghci.debugger/scripts/break031/a/A.hs - + testsuite/tests/ghci.debugger/scripts/break031/all.T - + testsuite/tests/ghci.debugger/scripts/break031/b/B.hs - + testsuite/tests/ghci.debugger/scripts/break031/break031a.script - + testsuite/tests/ghci.debugger/scripts/break031/break031a.stdout - + testsuite/tests/ghci.debugger/scripts/break031/break031b.script - + testsuite/tests/ghci.debugger/scripts/break031/break031b.stderr - + testsuite/tests/ghci.debugger/scripts/break031/break031b.stdout - + testsuite/tests/ghci.debugger/scripts/break031/unitA - + testsuite/tests/ghci.debugger/scripts/break031/unitB - testsuite/tests/ghci/linking/dyn/T3372.hs - + testsuite/tests/ghci/prog-mhu001/Makefile - + testsuite/tests/ghci/prog-mhu001/all.T - + testsuite/tests/ghci/prog-mhu001/e/E.hs - + testsuite/tests/ghci/prog-mhu001/prog-mhu001a.script - + testsuite/tests/ghci/prog-mhu001/prog-mhu001a.stdout - + testsuite/tests/ghci/prog-mhu001/prog-mhu001b.script - + testsuite/tests/ghci/prog-mhu001/prog-mhu001b.stdout - + testsuite/tests/ghci/prog-mhu001/prog-mhu001c.script - + testsuite/tests/ghci/prog-mhu001/prog-mhu001c.stdout - + testsuite/tests/ghci/prog-mhu001/prog-mhu001d.script - + testsuite/tests/ghci/prog-mhu001/prog-mhu001d.stdout - + testsuite/tests/ghci/prog-mhu001/prog-mhu001e.script - + testsuite/tests/ghci/prog-mhu001/prog-mhu001e.stdout - + testsuite/tests/ghci/prog-mhu001/prog-mhu001f.script - + testsuite/tests/ghci/prog-mhu001/prog-mhu001f.stdout - + testsuite/tests/ghci/prog-mhu001/unitE - + testsuite/tests/ghci/prog-mhu001/unitE-main-is - + testsuite/tests/ghci/prog-mhu002/Makefile - + testsuite/tests/ghci/prog-mhu002/a/A.hs - + testsuite/tests/ghci/prog-mhu002/all.T - + testsuite/tests/ghci/prog-mhu002/b/B.hs - + testsuite/tests/ghci/prog-mhu002/c/C.hs - + testsuite/tests/ghci/prog-mhu002/d/Main.hs - + testsuite/tests/ghci/prog-mhu002/prog-mhu002a.script - + testsuite/tests/ghci/prog-mhu002/prog-mhu002a.stderr - + testsuite/tests/ghci/prog-mhu002/prog-mhu002a.stdout - + testsuite/tests/ghci/prog-mhu002/prog-mhu002b.script - + testsuite/tests/ghci/prog-mhu002/prog-mhu002b.stderr - + testsuite/tests/ghci/prog-mhu002/prog-mhu002b.stdout - + testsuite/tests/ghci/prog-mhu002/prog-mhu002c.script - + testsuite/tests/ghci/prog-mhu002/prog-mhu002c.stdout - + testsuite/tests/ghci/prog-mhu002/prog-mhu002d.script - + testsuite/tests/ghci/prog-mhu002/prog-mhu002d.stdout - + testsuite/tests/ghci/prog-mhu002/prog-mhu002e.script - + testsuite/tests/ghci/prog-mhu002/prog-mhu002e.stdout - + testsuite/tests/ghci/prog-mhu002/prog-mhu002f.script - + testsuite/tests/ghci/prog-mhu002/prog-mhu002f.stdout - + testsuite/tests/ghci/prog-mhu002/unitA - + testsuite/tests/ghci/prog-mhu002/unitB - + testsuite/tests/ghci/prog-mhu002/unitC - + testsuite/tests/ghci/prog-mhu002/unitD - + testsuite/tests/ghci/prog-mhu003/Makefile - + testsuite/tests/ghci/prog-mhu003/a/A.hs - + testsuite/tests/ghci/prog-mhu003/all.T - + testsuite/tests/ghci/prog-mhu003/b/Foo.hs - + testsuite/tests/ghci/prog-mhu003/c/C.hs - + testsuite/tests/ghci/prog-mhu003/d/Foo.hs - + testsuite/tests/ghci/prog-mhu003/prog-mhu003.script - + testsuite/tests/ghci/prog-mhu003/prog-mhu003.stderr - + testsuite/tests/ghci/prog-mhu003/prog-mhu003.stdout - + testsuite/tests/ghci/prog-mhu003/unitA - + testsuite/tests/ghci/prog-mhu003/unitB - + testsuite/tests/ghci/prog-mhu003/unitC - + testsuite/tests/ghci/prog-mhu003/unitD - + testsuite/tests/ghci/prog-mhu004/Makefile - + testsuite/tests/ghci/prog-mhu004/a/Foo.hs - + testsuite/tests/ghci/prog-mhu004/all.T - + testsuite/tests/ghci/prog-mhu004/b/Foo.hs - + testsuite/tests/ghci/prog-mhu004/prog-mhu004a.script - + testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stderr - + testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stdout - + testsuite/tests/ghci/prog-mhu004/prog-mhu004b.script - + testsuite/tests/ghci/prog-mhu004/prog-mhu004b.stdout - + testsuite/tests/ghci/prog-mhu004/unitA - + testsuite/tests/ghci/prog-mhu004/unitB - testsuite/tests/ghci/prog010/ghci.prog010.script - testsuite/tests/ghci/prog018/prog018.stdout - + testsuite/tests/ghci/prog020/A.hs - + testsuite/tests/ghci/prog020/B.hs - + testsuite/tests/ghci/prog020/Makefile - + testsuite/tests/ghci/prog020/all.T - + testsuite/tests/ghci/prog020/ghci.prog020.script - + testsuite/tests/ghci/prog020/ghci.prog020.stderr - + testsuite/tests/ghci/prog020/ghci.prog020.stdout - testsuite/tests/ghci/scripts/T13869.stdout - testsuite/tests/ghci/scripts/T13997.stdout - testsuite/tests/ghci/scripts/T17669.stdout - testsuite/tests/ghci/scripts/T18330.stdout - testsuite/tests/ghci/scripts/T1914.stdout - testsuite/tests/ghci/scripts/T20217.stdout - testsuite/tests/ghci/scripts/T20587.stdout - testsuite/tests/ghci/scripts/T21110.stderr - testsuite/tests/ghci/scripts/T6105.stdout - testsuite/tests/ghci/scripts/T8042.stdout - testsuite/tests/ghci/scripts/T8042recomp.stdout - testsuite/tests/ghci/scripts/ghci024.stdout - testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 - testsuite/tests/ghci/scripts/ghci058.script - testsuite/tests/ghci/should_run/T10920.stderr - testsuite/tests/ghci/should_run/TopEnvIface.stdout - testsuite/tests/linters/notes.stdout - testsuite/tests/quasiquotation/T7918.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5e86adcb441af8ad66d363979db73… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5e86adcb441af8ad66d363979db73… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/ann-frame] FIXME: try to fix the primop
by Hannes Siebenhandl (＠fendor) 22 May '25

22 May '25

Hannes Siebenhandl pushed to branch wip/fendor/ann-frame at Glasgow Haskell Compiler / GHC Commits: 677c5337 by fendor at 2025-05-22T14:57:01+02:00 FIXME: try to fix the primop - - - - - 6 changed files: - compiler/GHC/Builtin/primops.txt.pp - libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs - libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc - libraries/ghc-heap/tests/ann_frame.hs - libraries/ghc-heap/tests/ann_frame.stdout - utils/deriveConstants/Main.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3932,7 +3932,7 @@ section "Annotating call stacks" ------------------------------------------------------------------------ primop AnnotateStackOp "annotateStack#" GenPrimOp - b -> a_reppoly -> a_reppoly + b -> a -> (# a #) { Pushes an annotation frame to the stack which can be reported by backtraces. } with out_of_line = True ===================================== libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE ImplicitParams #-} module GHC.Stack.Annotation.Experimental where @@ -35,8 +36,9 @@ instance Show SrcLocAnno where ] annotateStackWith :: forall a b. (Typeable a, Show a) => a -> b -> b -annotateStackWith ann = - annotateStack# (StackAnnotation ann) +annotateStackWith ann b = + case annotateStack# (StackAnnotation ann) b of + (# r #) -> r annotateCallStack :: HasCallStack => a -> a annotateCallStack = ===================================== libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc ===================================== @@ -89,7 +89,8 @@ sizeStgRetFunFrame :: Int sizeStgRetFunFrame = bytesToWords (#const SIZEOF_StgRetFun) sizeStgAnnFrame :: Int -sizeStgAnnFrame = bytesToWords (#const SIZEOF_StgAnnFrame) +sizeStgAnnFrame = bytesToWords $ + (#const SIZEOF_StgAnnFrame_NoHdr) + (#size StgHeader) offsetStgAnnFrameAnn :: WordOffset offsetStgAnnFrameAnn = byteOffsetToWordOffset $ ===================================== libraries/ghc-heap/tests/ann_frame.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE UnboxedTuples #-} import Data.Typeable import GHC.Exts @@ -16,8 +17,9 @@ annotateStack :: forall a r b. (Typeable a, Show a) => a -> b -> b -annotateStack ann = - annotateStack# (StackAnnotation ann) +annotateStack ann b = + case annotateStack# (StackAnnotation ann) b of + (# r #) -> r hello :: Int -> Int -> Int hello x y = annotateStack (x,y) $ ===================================== libraries/ghc-heap/tests/ann_frame.stdout ===================================== @@ -1,2 +1,4 @@ ["(2,3)"] 47 +["\"bar\"","\"foo\"","\"tailCallEx\""] +40 ===================================== utils/deriveConstants/Main.hs ===================================== @@ -443,7 +443,7 @@ wanteds os = concat ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" ,closureField C "StgDeadThreadFrame" "result" - ,structSize C "StgAnnFrame" + ,closureSize Both "StgAnnFrame" ,closureField C "StgAnnFrame" "ann" ,closureSize Both "StgMutArrPtrs" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/677c5337c764c880d1769dd7159c372… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/677c5337c764c880d1769dd7159c372… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/spec_tyfams] Specialise: Improve specialisation by refactoring interestingDict
by Andreas Klebinger (＠AndreasK) 22 May '25

22 May '25

Andreas Klebinger pushed to branch wip/andreask/spec_tyfams at Glasgow Haskell Compiler / GHC Commits: 99791506 by Andreas Klebinger at 2025-05-22T12:47:56+02:00 Specialise: Improve specialisation by refactoring interestingDict This MR addresses #26051, which concerns missed type-class specialisation. The main payload of the MR is to completely refactor the key function `interestingDict` in GHC.Core.Opt.Specialise The main change is that we now also look at the structure of the dictionary we consider specializing on, rather than only the type. See the big `Note [Interesting dictionary arguments]` - - - - - 15 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - + testsuite/tests/perf/should_run/SpecTyFamRun.hs - + testsuite/tests/perf/should_run/SpecTyFamRun.stdout - + testsuite/tests/perf/should_run/SpecTyFam_Import.hs - testsuite/tests/perf/should_run/all.T - + testsuite/tests/simplCore/should_compile/T26051.hs - + testsuite/tests/simplCore/should_compile/T26051.stderr - + testsuite/tests/simplCore/should_compile/T26051_Import.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE MultiWayIf #-} + {- (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 @@ -14,9 +16,9 @@ import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Core.Type hiding( substTy, substCo, extendTvSubst, zapSubst ) -import GHC.Core.Multiplicity -import GHC.Core.SimpleOpt( defaultSimpleOpts, simpleOptExprWith ) +import GHC.Core.SimpleOpt( defaultSimpleOpts, simpleOptExprWith, exprIsConApp_maybe ) import GHC.Core.Predicate +import GHC.Core.Class( classMethods ) import GHC.Core.Coercion( Coercion ) import GHC.Core.Opt.Monad import qualified GHC.Core.Subst as Core @@ -26,12 +28,12 @@ import GHC.Core.Make ( mkLitRubbish ) import GHC.Core.Unify ( tcMatchTy ) import GHC.Core.Rules import GHC.Core.Utils ( exprIsTrivial, exprIsTopLevelBindable - , mkCast, exprType + , mkCast, exprType, exprIsHNF , stripTicksTop, mkInScopeSetBndrs ) import GHC.Core.FVs import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList ) import GHC.Core.Opt.Arity( collectBindersPushingCo ) --- import GHC.Core.Ppr( pprIds ) +import GHC.Core.Ppr( pprIds ) import GHC.Builtin.Types ( unboxedUnitTy ) @@ -64,8 +66,11 @@ import GHC.Unit.Module.ModGuts import GHC.Core.Unfold import Data.List( partition ) --- import Data.List.NonEmpty ( NonEmpty (..) ) import GHC.Core.Subst (substTickish) +import GHC.Core.TyCon (tyConClass_maybe) +import GHC.Core.DataCon (dataConTyCon) + +import Control.Monad {- ************************************************************************ @@ -1585,9 +1590,9 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs -- switch off specialisation for inline functions = -- pprTrace "specCalls: some" (vcat - -- [ text "function" <+> ppr fn - -- , text "calls:" <+> ppr calls_for_me - -- , text "subst" <+> ppr (se_subst env) ]) $ + -- [ text "function" <+> ppr fn + -- , text "calls:" <+> ppr calls_for_me + -- , text "subst" <+> ppr (se_subst env) ]) $ foldlM spec_call ([], [], emptyUDs) calls_for_me | otherwise -- No calls or RHS doesn't fit our preconceptions @@ -1635,21 +1640,21 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs , rule_bndrs, rule_lhs_args , spec_bndrs1, dx_binds, spec_args) <- specHeader env rhs_bndrs all_call_args --- ; pprTrace "spec_call" (vcat --- [ text "fun: " <+> ppr fn --- , text "call info: " <+> ppr _ci --- , text "useful: " <+> ppr useful --- , text "rule_bndrs:" <+> ppr rule_bndrs --- , text "lhs_args: " <+> ppr rule_lhs_args --- , text "spec_bndrs1:" <+> ppr spec_bndrs1 --- , text "leftover_bndrs:" <+> pprIds leftover_bndrs --- , text "spec_args: " <+> ppr spec_args --- , text "dx_binds: " <+> ppr dx_binds --- , text "rhs_bndrs" <+> ppr rhs_bndrs --- , text "rhs_body" <+> ppr rhs_body --- , text "rhs_env2: " <+> ppr (se_subst rhs_env2) --- , ppr dx_binds ]) $ --- return () + ; when False $ pprTrace "spec_call" (vcat + [ text "fun: " <+> ppr fn + , text "call info: " <+> ppr _ci + , text "useful: " <+> ppr useful + , text "rule_bndrs:" <+> ppr rule_bndrs + , text "lhs_args: " <+> ppr rule_lhs_args + , text "spec_bndrs1:" <+> ppr spec_bndrs1 + , text "leftover_bndrs:" <+> pprIds leftover_bndrs + , text "spec_args: " <+> ppr spec_args + , text "dx_binds: " <+> ppr dx_binds + , text "rhs_bndrs" <+> ppr rhs_bndrs + , text "rhs_body" <+> ppr rhs_body + , text "rhs_env2: " <+> ppr (se_subst rhs_env2) + , ppr dx_binds ]) $ + return () ; let all_rules = rules_acc ++ existing_rules -- all_rules: we look both in the rules_acc (generated by this invocation @@ -3043,30 +3048,15 @@ mkCallUDs' env f args -- For "invisibleFunArg", which are the type-class dictionaries, -- we decide on a case by case basis if we want to specialise -- on this argument; if so, SpecDict, if not UnspecArg - mk_spec_arg arg (Anon pred af) + mk_spec_arg arg (Anon _pred af) | isInvisibleFunArg af - , interestingDict arg (scaledThing pred) + , interestingDict env arg + -- , interestingDict arg (scaledThing pred) -- See Note [Interesting dictionary arguments] = SpecDict arg | otherwise = UnspecArg -{- -Note [Ticks on applications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Ticks such as source location annotations can sometimes make their way -onto applications (see e.g. #21697). So if we see something like - - App (Tick _ f) e - -we need to descend below the tick to find what the real function being -applied is. - -The resulting RULE also has to be able to match this annotated use -site, so we only look through ticks that RULE matching looks through -(see Note [Tick annotations in RULE matching] in GHC.Core.Rules). --} - wantCallsFor :: SpecEnv -> Id -> Bool -- See Note [wantCallsFor] wantCallsFor _env f @@ -3086,8 +3076,60 @@ wantCallsFor _env f WorkerLikeId {} -> True RepPolyId {} -> True -{- Note [wantCallsFor] -~~~~~~~~~~~~~~~~~~~~~~ +interestingDict :: SpecEnv -> CoreExpr -> Bool +-- This is a subtle and important function +-- See Note [Interesting dictionary arguments] +interestingDict env (Var v) -- See (ID3) and (ID5) + | Just rhs <- maybeUnfoldingTemplate (idUnfolding v) + -- might fail for loop breaker dicts but that seems fine. + = interestingDict env rhs + +interestingDict env arg -- Main Plan: use exprIsConApp_maybe + | Cast inner_arg _ <- arg -- See (ID5) + = if | isConstraintKind $ typeKind $ exprType inner_arg + -- If coercions were always homo-kinded, we'd know + -- that this would be the only case + -> interestingDict env inner_arg + + -- Check for an implicit parameter at the top + | Just (cls,_) <- getClassPredTys_maybe arg_ty + , isIPClass cls -- See (ID4) + -> False + + -- Otherwise we are unwrapping a unary type class + | otherwise + -> exprIsHNF arg -- See (ID7) + + | Just (_, _, data_con, _tys, args) <- exprIsConApp_maybe in_scope_env arg + , Just cls <- tyConClass_maybe (dataConTyCon data_con) + , not_ip_like -- See (ID4) + = if null (classMethods cls) -- See (ID6) + then any (interestingDict env) args + else True + + | otherwise + = not (exprIsTrivial arg) && not_ip_like -- See (ID8) + where + arg_ty = exprType arg + not_ip_like = not (couldBeIPLike arg_ty) + in_scope_env = ISE (substInScopeSet $ se_subst env) realIdUnfolding + +{- Note [Ticks on applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Ticks such as source location annotations can sometimes make their way +onto applications (see e.g. #21697). So if we see something like + + App (Tick _ f) e + +we need to descend below the tick to find what the real function being +applied is. + +The resulting RULE also has to be able to match this annotated use +site, so we only look through ticks that RULE matching looks through +(see Note [Tick annotations in RULE matching] in GHC.Core.Rules). + +Note [wantCallsFor] +~~~~~~~~~~~~~~~~~~~ `wantCallsFor env f` says whether the Specialiser should collect calls for function `f`; other thing being equal, the fewer calls we collect the better. It is False for things we can't specialise: @@ -3113,44 +3155,91 @@ collect usage info for imported overloaded functions. Note [Interesting dictionary arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In `mkCallUDs` we only use `SpecDict` for dictionaries of which -`interestingDict` holds. Otherwise we use `UnspecArg`. Two reasons: - -* Consider this - \a.\d:Eq a. let f = ... in ...(f d)... - There really is not much point in specialising f wrt the dictionary d, - because the code for the specialised f is not improved at all, because - d is lambda-bound. We simply get junk specialisations. - -* Consider this (#25703): - f :: (Eq a, Show b) => a -> b -> INt - goo :: forall x. (Eq x) => x -> blah - goo @x (d:Eq x) (arg:x) = ...(f @x @Int d $fShowInt)... - If we built a `ci_key` with a (SpecDict d) for `d`, we would end up - discarding the call at the `\d`. But if we use `UnspecArg` for that - uninteresting `d`, we'll get a `ci_key` of - f @x @Int UnspecArg (SpecDict $fShowInt) - and /that/ can float out to f's definition and specialise nicely. - Hooray. (NB: the call can float only if `-fpolymorphic-specialisation` - is on; otherwise it'll be trapped by the `\@x -> ...`.)( - -What is "interesting"? (See `interestingDict`.) Just that it has *some* -structure. But what about variables? We look in the variable's /unfolding/. -And that means that we must be careful to ensure that dictionaries /have/ -unfoldings, - -* cloneBndrSM discards non-Stable unfoldings -* specBind updates the unfolding after specialisation - See Note [Update unfolding after specialisation] -* bindAuxiliaryDict adds an unfolding for an aux dict - see Note [Specialisation modulo dictionary selectors] -* specCase adds unfoldings for the new bindings it creates - -We accidentally lost accurate tracking of local variables for a long -time, because cloned variables didn't have unfoldings. But makes a -massive difference in a few cases, eg #5113. For nofib as a -whole it's only a small win: 2.2% improvement in allocation for ansi, -1.2% for bspt, but mostly 0.0! Average 0.1% increase in binary size. +Consider this + \a.\d:Eq a. let f = ... in ...(f d)... +There really is not much point in specialising f wrt the dictionary d, +because the code for the specialised f is not improved at all, because +d is lambda-bound. We simply get junk specialisations. + +What is "interesting"? Our Main Plan is to use `exprIsConApp_maybe` to see +if the argument is a dictionary constructor applied to some arguments, in which +case we can clearly specialise. But there are wrinkles: + +(ID1) Note that we look at the argument /term/, not its /type/. Suppose the + argument is + (% d1, d2 %) |> co + where co :: (% Eq [a], Show [a] %) ~ F Int a, and `F` is a type family. + Then its type (F Int a) looks very un-informative, but the term is super + helpful. See #19747 (where missing this point caused a 70x slow down) + and #7785. + +(ID2) Note that the Main Plan works fine for an argument that is a DFun call, + e.g. $fOrdList $dOrdInt + because `exprIsConApp_maybe` cleverly deals with DFunId applications. Good! + +(ID3) For variables, we look in the variable's /unfolding/. And that means + that we must be careful to ensure that dictionaries /have/ unfoldings: + * cloneBndrSM discards non-Stable unfoldings + * specBind updates the unfolding after specialisation + See Note [Update unfolding after specialisation] + * bindAuxiliaryDict adds an unfolding for an aux dict + see Note [Specialisation modulo dictionary selectors] + * specCase adds unfoldings for the new bindings it creates + + We accidentally lost accurate tracking of local variables for a long + time, because cloned variables didn't have unfoldings. But makes a + massive difference in a few cases, eg #5113. For nofib as a + whole it's only a small win: 2.2% improvement in allocation for ansi, + 1.2% for bspt, but mostly 0.0! Average 0.1% increase in binary size. + +(ID4) We must be very careful not to specialise on a "dictionary" that is, or contains + an implicit parameter, because implicit parameters are emphatically not singleton + types. See #25999: + useImplicit :: (?i :: Int) => Int + useImplicit = ?i + 1 + + foo = let ?i = 1 in (useImplicit, let ?i = 2 in useImplicit) + Both calls to `useImplicit` are at type `?i::Int`, but they pass different values. + We must not specialise on implicit parameters! Hence the call to `couldBeIPLike`. + +(ID5) Suppose the argument is (e |> co). Can we rely on `exprIsConApp_maybe` to deal + with the coercion. No! That only works if (co :: C t1 ~ C t2) with the same type + constructor at the top of both sides. But see the example in (ID1), where that + is not true. For thes same reason, we can't rely on `exprIsConApp_maybe` to look + through unfoldings (because there might be a cast inside), hence dealing with + expandable unfoldings in `interestingDict` directly. + +(ID6) The Main Plan says that it's worth specialising if the argument is an application + of a dictionary contructor. But what if the dictionary has no methods? Then we + gain nothing by specialising, unless the /superclasses/ are interesting. A case + in point is constraint tuples (% d1, .., dn %); a constraint N-tuple is a class + with N superclasses and no methods. + +(ID7) A unary (single-method) class is currently represented by (meth |> co). We + will unwrap the cast (see (ID5)) and then want to reply "yes" if the method + has any struture. We rather arbitrarily use `exprIsHNF` for this. (We plan a + new story for unary classes, see #23109, and this special case will become + irrelevant.) + +(ID8) Sadly, if `exprIsConApp_maybe` says Nothing, we still want to treat a + non-trivial argument as interesting. In T19695 we have this: + askParams :: Monad m => blah + mhelper :: MonadIO m => blah + mhelper (d:MonadIO m) = ...(askParams @m ($p1 d)).... + where `$p1` is the superclass selector for `MonadIO`. Now, if `mhelper` is + specialised at `Handler` we'll get this call in the specialised `$smhelper`: + askParams @Handler ($p1 $fMonadIOHandler) + and we /definitely/ want to specialise that, even though the argument isn't + visibly a dictionary application. In fact the specialiser fires the superclass + selector rule (see Note [Fire rules in the specialiser]), so we get + askParams @Handler ($cp1MonadIO $fMonadIOIO) + but it /still/ doesn't look like a dictionary application. + + Conclusion: we optimistically assume that any non-trivial argument is worth + specialising on. + + So why do the `exprIsConApp_maybe` and `Cast` stuff? Because we want to look + under type-family casts (ID1) and constraint tuples (ID6). Note [Update unfolding after specialisation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -3178,6 +3267,7 @@ Consider (#21848) Now `f` turns into: f @a @b (dd :: D a) (ds :: Show b) a b + = let dc :: D a = %p1 dd -- Superclass selection in meth @a dc .... meth @a dc .... @@ -3193,27 +3283,6 @@ in the NonRec case of specBind. (This is too exotic to trouble with the Rec case.) -} -interestingDict :: CoreExpr -> Type -> Bool --- A dictionary argument is interesting if it has *some* structure, --- see Note [Interesting dictionary arguments] --- NB: "dictionary" arguments include constraints of all sorts, --- including equality constraints; hence the Coercion case --- To make this work, we need to ensure that dictionaries have --- unfoldings in them. -interestingDict arg arg_ty - | not (typeDeterminesValue arg_ty) = False -- See Note [Type determines value] - | otherwise = go arg - where - go (Var v) = hasSomeUnfolding (idUnfolding v) - || isDataConWorkId v - go (Type _) = False - go (Coercion _) = False - go (App fn (Type _)) = go fn - go (App fn (Coercion _)) = go fn - go (Tick _ a) = go a - go (Cast e _) = go e - go _ = True - thenUDs :: UsageDetails -> UsageDetails -> UsageDetails thenUDs (MkUD {ud_binds = db1, ud_calls = calls1}) (MkUD {ud_binds = db2, ud_calls = calls2}) ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -24,7 +24,7 @@ module GHC.Core.Predicate ( classMethodTy, classMethodInstTy, -- Implicit parameters - isIPLikePred, mentionsIP, isIPTyCon, isIPClass, + couldBeIPLike, mightMentionIP, isIPTyCon, isIPClass, isCallStackTy, isCallStackPred, isCallStackPredTy, isExceptionContextPred, isExceptionContextTy, isIPPred_maybe, @@ -126,9 +126,12 @@ isDictTy ty = isClassPred pred where (_, pred) = splitInvisPiTys ty +-- | Is the type *guaranteed* to determine the value? +-- +-- Might say No even if the type does determine the value. (See the Note) typeDeterminesValue :: Type -> Bool -- See Note [Type determines value] -typeDeterminesValue ty = isDictTy ty && not (isIPLikePred ty) +typeDeterminesValue ty = isDictTy ty && not (couldBeIPLike ty) getClassPredTys :: HasDebugCallStack => PredType -> (Class, [Type]) getClassPredTys ty = case getClassPredTys_maybe ty of @@ -171,6 +174,10 @@ So we treat implicit params just like ordinary arguments for the purposes of specialisation. Note that we still want to specialise functions with implicit params if they have *other* dicts which are class params; see #17930. + +It's also not always possible to infer that a type determines the value +if type families are in play. See #19747 for one such example. + -} -- --------------------- Equality predicates --------------------------------- @@ -421,44 +428,44 @@ isCallStackTy ty | otherwise = False --- --------------------- isIPLike and mentionsIP -------------------------- +-- --------------------- couldBeIPLike and mightMentionIP -------------------------- -- See Note [Local implicit parameters] -isIPLikePred :: Type -> Bool +couldBeIPLike :: Type -> Bool -- Is `pred`, or any of its superclasses, an implicit parameter? -- See Note [Local implicit parameters] -isIPLikePred pred = - mentions_ip_pred initIPRecTc (const True) (const True) pred - -mentionsIP :: (Type -> Bool) -- ^ predicate on the string - -> (Type -> Bool) -- ^ predicate on the type - -> Class - -> [Type] -> Bool --- ^ @'mentionsIP' str_cond ty_cond cls tys@ returns @True@ if: +couldBeIPLike pred + = might_mention_ip1 initIPRecTc (const True) (const True) pred + +mightMentionIP :: (Type -> Bool) -- ^ predicate on the string + -> (Type -> Bool) -- ^ predicate on the type + -> Class + -> [Type] -> Bool +-- ^ @'mightMentionIP' str_cond ty_cond cls tys@ returns @True@ if: -- -- - @cls tys@ is of the form @IP str ty@, where @str_cond str@ and @ty_cond ty@ -- are both @True@, -- - or any superclass of @cls tys@ has this property. -- -- See Note [Local implicit parameters] -mentionsIP = mentions_ip initIPRecTc +mightMentionIP = might_mention_ip initIPRecTc -mentions_ip :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Class -> [Type] -> Bool -mentions_ip rec_clss str_cond ty_cond cls tys +might_mention_ip :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Class -> [Type] -> Bool +might_mention_ip rec_clss str_cond ty_cond cls tys | Just (str_ty, ty) <- isIPPred_maybe cls tys = str_cond str_ty && ty_cond ty | otherwise - = or [ mentions_ip_pred rec_clss str_cond ty_cond (classMethodInstTy sc_sel_id tys) + = or [ might_mention_ip1 rec_clss str_cond ty_cond (classMethodInstTy sc_sel_id tys) | sc_sel_id <- classSCSelIds cls ] -mentions_ip_pred :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Type -> Bool -mentions_ip_pred rec_clss str_cond ty_cond ty +might_mention_ip1 :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Type -> Bool +might_mention_ip1 rec_clss str_cond ty_cond ty | Just (cls, tys) <- getClassPredTys_maybe ty , let tc = classTyCon cls , Just rec_clss' <- if isTupleTyCon tc then Just rec_clss else checkRecTc rec_clss tc - = mentions_ip rec_clss' str_cond ty_cond cls tys + = might_mention_ip rec_clss' str_cond ty_cond cls tys | otherwise = False -- Includes things like (D []) where D is -- a Constraint-ranged family; #7785 @@ -471,7 +478,7 @@ initIPRecTc = setRecTcMaxBound 1 initRecTc See also wrinkle (SIP1) in Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. -The function isIPLikePred tells if this predicate, or any of its +The function couldBeIPLike tells if this predicate, or any of its superclasses, is an implicit parameter. Why are implicit parameters special? Unlike normal classes, we can @@ -479,7 +486,7 @@ have local instances for implicit parameters, in the form of let ?x = True in ... So in various places we must be careful not to assume that any value of the right type will do; we must carefully look for the innermost binding. -So isIPLikePred checks whether this is an implicit parameter, or has +So couldBeIPLike checks whether this is an implicit parameter, or has a superclass that is an implicit parameter. Several wrinkles @@ -520,16 +527,16 @@ Small worries (Sept 20): think nothing does. * I'm a little concerned about type variables; such a variable might be instantiated to an implicit parameter. I don't think this - matters in the cases for which isIPLikePred is used, and it's pretty + matters in the cases for which couldBeIPLike is used, and it's pretty obscure anyway. * The superclass hunt stops when it encounters the same class again, but in principle we could have the same class, differently instantiated, and the second time it could have an implicit parameter I'm going to treat these as problems for another day. They are all exotic. -Note [Using typesAreApart when calling mentionsIP] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We call 'mentionsIP' in two situations: +Note [Using typesAreApart when calling mightMentionIP] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We call 'mightMentionIP' in two situations: (1) to check that a predicate does not contain any implicit parameters IP str ty, for a fixed literal str and any type ty, ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1914,7 +1914,7 @@ growThetaTyVars theta tcvs | otherwise = transCloVarSet mk_next seed_tcvs where seed_tcvs = tcvs `unionVarSet` tyCoVarsOfTypes ips - (ips, non_ips) = partition isIPLikePred theta + (ips, non_ips) = partition couldBeIPLike theta -- See Note [Inheriting implicit parameters] mk_next :: VarSet -> VarSet -- Maps current set to newly-grown ones ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -749,7 +749,7 @@ shortCutSolver dflags ev_w ev_i -- programs should typecheck regardless of whether we take this step or -- not. See Note [Shortcut solving] - , not (isIPLikePred (ctEvPred ev_w)) -- Not for implicit parameters (#18627) + , not (couldBeIPLike (ctEvPred ev_w)) -- Not for implicit parameters (#18627) , not (xopt LangExt.IncoherentInstances dflags) -- If IncoherentInstances is on then we cannot rely on coherence of proofs ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -2040,10 +2040,10 @@ solveOneFromTheOther ct_i ct_w is_wsc_orig_w = isWantedSuperclassOrigin orig_w different_level_strategy -- Both Given - | isIPLikePred pred = if lvl_w `strictlyDeeperThan` lvl_i then KeepWork else KeepInert - | otherwise = if lvl_w `strictlyDeeperThan` lvl_i then KeepInert else KeepWork + | couldBeIPLike pred = if lvl_w `strictlyDeeperThan` lvl_i then KeepWork else KeepInert + | otherwise = if lvl_w `strictlyDeeperThan` lvl_i then KeepInert else KeepWork -- See Note [Replacement vs keeping] part (1) - -- For the isIPLikePred case see Note [Shadowing of implicit parameters] + -- For the couldBeIPLike case see Note [Shadowing of implicit parameters] -- in GHC.Tc.Solver.Dict same_level_strategy -- Both Given ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -401,8 +401,8 @@ updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev, di_tys = tys }) -- an implicit parameter (?str :: ty) for the given 'str' and any type 'ty'? does_not_mention_ip_for :: Type -> DictCt -> Bool does_not_mention_ip_for str_ty (DictCt { di_cls = cls, di_tys = tys }) - = not $ mentionsIP (not . typesAreApart str_ty) (const True) cls tys - -- See Note [Using typesAreApart when calling mentionsIP] + = not $ mightMentionIP (not . typesAreApart str_ty) (const True) cls tys + -- See Note [Using typesAreApart when calling mightMentionIP] -- in GHC.Core.Predicate updInertIrreds :: IrredCt -> TcS () @@ -534,7 +534,7 @@ updSolvedDicts what dict_ct@(DictCt { di_cls = cls, di_tys = tys, di_ev = ev }) = do { is_callstack <- is_tyConTy isCallStackTy callStackTyConName ; is_exceptionCtx <- is_tyConTy isExceptionContextTy exceptionContextTyConName ; let contains_callstack_or_exceptionCtx = - mentionsIP + mightMentionIP (const True) -- NB: the name of the call-stack IP is irrelevant -- e.g (?foo :: CallStack) counts! @@ -552,9 +552,9 @@ updSolvedDicts what dict_ct@(DictCt { di_cls = cls, di_tys = tys, di_ev = ev }) -- Return a predicate that decides whether a type is CallStack -- or ExceptionContext, accounting for e.g. type family reduction, as - -- per Note [Using typesAreApart when calling mentionsIP]. + -- per Note [Using typesAreApart when calling mightMentionIP]. -- - -- See Note [Using isCallStackTy in mentionsIP]. + -- See Note [Using isCallStackTy in mightMentionIP]. is_tyConTy :: (Type -> Bool) -> Name -> TcS (Type -> Bool) is_tyConTy is_eq tc_name = do { (mb_tc, _) <- wrapTcS $ TcM.tryTc $ TcM.tcLookupTyCon tc_name @@ -582,14 +582,14 @@ in a different context! See also Note [Shadowing of implicit parameters], which deals with a similar problem with Given implicit parameter constraints. -Note [Using isCallStackTy in mentionsIP] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Using isCallStackTy in mightMentionIP] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To implement Note [Don't add HasCallStack constraints to the solved set], we need to check whether a constraint contains a HasCallStack or HasExceptionContext constraint. We do this using the 'mentionsIP' function, but as per -Note [Using typesAreApart when calling mentionsIP] we don't want to simply do: +Note [Using typesAreApart when calling mightMentionIP] we don't want to simply do: - mentionsIP + mightMentionIP (const True) -- (ignore the implicit parameter string) (isCallStackTy <||> isExceptionContextTy) ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -155,7 +155,7 @@ module GHC.Tc.Utils.TcType ( mkTyConTy, mkTyVarTy, mkTyVarTys, mkTyCoVarTy, mkTyCoVarTys, - isClassPred, isEqPred, isIPLikePred, isEqClassPred, + isClassPred, isEqPred, couldBeIPLike, isEqClassPred, isEqualityClass, mkClassPred, tcSplitQuantPredTy, tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy, isRuntimeRepVar, isFixedRuntimeRepKind, @@ -1819,7 +1819,7 @@ pickCapturedPreds pickCapturedPreds qtvs theta = filter captured theta where - captured pred = isIPLikePred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) + captured pred = couldBeIPLike pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) -- Superclasses ===================================== testsuite/tests/perf/should_run/SpecTyFamRun.hs ===================================== @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fspecialise-aggressively #-} +{-# OPTIONS_GHC -fno-spec-constr #-} +module Main(main) where + +import SpecTyFam_Import (specMe, MaybeShowNum) +import GHC.Exts + +-- We want to see a specialization of `specMe` which doesn't take a dictionary at runtime. + +{-# NOINLINE foo #-} +foo :: Int -> (String,Int) +-- We want specMe to be specialized, but not inlined +foo x = specMe True x + +main = print $ sum $ map (snd . foo) [1..1000 :: Int] ===================================== testsuite/tests/perf/should_run/SpecTyFamRun.stdout ===================================== @@ -0,0 +1 @@ +500500 ===================================== testsuite/tests/perf/should_run/SpecTyFam_Import.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE BangPatterns #-} + +module SpecTyFam_Import (specMe, MaybeShowNum) where + +import Data.Kind + +type family MaybeShowNum a n :: Constraint where + MaybeShowNum a n = (Show a, Num n) + +{-# INLINABLE specMe #-} +specMe :: (Integral n, MaybeShowNum a n) => a -> n -> (String,n) +specMe s !n = (show s, n+1 `div` 2) ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -423,3 +423,12 @@ test('ByteCodeAsm', ], compile_and_run, ['-package ghc']) + +# Check that $s$wspecMe doesn't have any dictionary args after specialization in addition to perf stats +# See also #19747 +test('SpecTyFamRun', [ grep_errmsg(r'foo') + , extra_files(['SpecTyFam_Import.hs']) + , only_ways(['optasm']) + , collect_stats('bytes allocated', 5)], + multimod_compile_and_run, + ['SpecTyFamRun', '-O2']) ===================================== testsuite/tests/simplCore/should_compile/T26051.hs ===================================== @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fspecialise-aggressively #-} +{-# OPTIONS_GHC -fno-spec-constr #-} + +module T26051(main, foo) where + +import T26051_Import (specMe, MaybeShowNum) +import GHC.Exts + +-- We want to see a specialization of `specMe` which doesn't take a dictionary at runtime. + +{-# OPAQUE foo #-} +foo :: Int -> (String,Int) +foo x = specMe True x + +main = print $ sum $ map (snd . foo) [1..1000 :: Int] ===================================== testsuite/tests/simplCore/should_compile/T26051.stderr ===================================== @@ -0,0 +1,78 @@ +[1 of 2] Compiling SpecTyFam_Import ( SpecTyFam_Import.hs, SpecTyFam_Import.o ) + +==================== Specialise ==================== +Result size of Specialise = {terms: 31, types: 39, coercions: 8, joins: 0/1} + +-- RHS size: {terms: 30, types: 27, coercions: 8, joins: 0/1} +specMe [InlPrag=INLINABLE] :: forall n a. (Integral n, MaybeShowNum a n) => a -> n -> (String, n) +[LclIdX, + Arity=4, + Unf=Unf{Src=StableUser, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 0 0 20] 260 10 + Tmpl= \ (@n) (@a) ($dIntegral [Occ=Once1] :: Integral n) (irred :: MaybeShowNum a n) (eta [Occ=Once1] :: a) (eta [Occ=Once1] :: n) -> + let { + $dNum :: Num n + [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=True, Guidance=IF_ARGS [] 20 0}] + $dNum = GHC.Internal.Classes.$p1CTuple2 @(Show a) @(Num n) (irred `cast` (Sub (SpecTyFam_Import.D:R:MaybeShowNum[0] <a>_N <n>_N) :: MaybeShowNum a n ~R# (Show a, Num n))) } in + case eta of n [Occ=Once1] { __DEFAULT -> (show @a (GHC.Internal.Classes.$p0CTuple2 @(Show a) @(Num n) (irred `cast` (Sub (SpecTyFam_Import.D:R:MaybeShowNum[0] <a>_N <n>_N) :: MaybeShowNum a n ~R# (Show a, Num n)))) eta, + @n $dNum n (div @n $dIntegral (fromInteger @n $dNum (GHC.Internal.Bignum.Integer.IS 1#)) (fromInteger @n $dNum (GHC.Internal.Bignum.Integer.IS 2#)))) }}] +specMe + = \ (@n) (@a) ($dIntegral :: Integral n) (irred :: MaybeShowNum a n) (eta :: a) (eta :: n) -> + let { + $dNum :: Num n + [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=True, Guidance=IF_ARGS [] 20 0}] + $dNum = GHC.Internal.Classes.$p1CTuple2 @(Show a) @(Num n) (irred `cast` (Sub (SpecTyFam_Import.D:R:MaybeShowNum[0] <a>_N <n>_N) :: MaybeShowNum a n ~R# (Show a, Num n))) } in + case eta of n { __DEFAULT -> (show @a (GHC.Internal.Classes.$p0CTuple2 @(Show a) @(Num n) (irred `cast` (Sub (SpecTyFam_Import.D:R:MaybeShowNum[0] <a>_N <n>_N) :: MaybeShowNum a n ~R# (Show a, Num n)))) eta, + @n $dNum n (div @n $dIntegral (fromInteger @n $dNum (GHC.Internal.Bignum.Integer.IS 1#)) (fromInteger @n $dNum (GHC.Internal.Bignum.Integer.IS 2#)))) } + + + +[2 of 2] Compiling SpecTyFam ( SpecTyFam.hs, SpecTyFam.o ) + +==================== Specialise ==================== +Result size of Specialise = {terms: 84, types: 86, coercions: 13, joins: 0/1} + +Rec { +-- RHS size: {terms: 3, types: 4, coercions: 0, joins: 0/0} +$dCTuple2 :: (Show Bool, Num Int) +[LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +$dCTuple2 = (GHC.Internal.Show.$fShowBool, GHC.Internal.Num.$fNumInt) + +-- RHS size: {terms: 19, types: 9, coercions: 0, joins: 0/1} +$s$wspecMe [InlPrag=INLINABLE[2]] :: Bool -> Int -> (# String, Int #) +[LclId, Arity=2] +$s$wspecMe + = \ (eta [Occ=Once1] :: Bool) (eta1 [Occ=Once1] :: Int) -> + let { + $dNum :: Num Int + [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] + $dNum = GHC.Internal.Num.$fNumInt } in + case eta1 of n1 [Occ=Once1] { __DEFAULT -> (# GHC.Internal.Show.$fShowBool_$cshow eta, GHC.Internal.Num.$fNumInt_$c+ n1 (GHC.Internal.Real.$fIntegralInt_$cdiv (GHC.Internal.Num.$fNumInt_$cfromInteger (GHC.Internal.Bignum.Integer.IS 1#)) (GHC.Internal.Num.$fNumInt_$cfromInteger (GHC.Internal.Bignum.Integer.IS 2#))) #) } + +-- RHS size: {terms: 12, types: 13, coercions: 5, joins: 0/0} +$sspecMe [InlPrag=INLINABLE[2]] :: Bool -> Int -> (String, Int) +[LclId, + Arity=2, + Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (eta [Occ=Once1] :: Bool) (eta1 [Occ=Once1] :: Int) -> case SpecTyFam_Import.$wspecMe @Int @Bool GHC.Internal.Real.$fIntegralInt ($dCTuple2 `cast` (Sub (Sym (SpecTyFam_Import.D:R:MaybeShowNum[0] <Bool>_N <Int>_N)) :: (Show Bool, Num Int) ~R# MaybeShowNum Bool Int)) eta eta1 of { (# ww [Occ=Once1], ww1 [Occ=Once1] #) -> (ww, ww1) }}] +$sspecMe = \ (eta [Occ=Once1] :: Bool) (eta1 [Occ=Once1] :: Int) -> case SpecTyFam_Import.$wspecMe @Int @Bool GHC.Internal.Real.$fIntegralInt ($dCTuple2 `cast` (Sub (Sym (SpecTyFam_Import.D:R:MaybeShowNum[0] <Bool>_N <Int>_N)) :: (Show Bool, Num Int) ~R# MaybeShowNum Bool Int)) eta eta1 of { (# ww [Occ=Once1], ww1 [Occ=Once1] #) -> (ww, ww1) } +end Rec } + +-- RHS size: {terms: 6, types: 3, coercions: 5, joins: 0/0} +foo [InlPrag=OPAQUE] :: Int -> (String, Int) +[LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 50 0}] +foo = \ (x :: Int) -> specMe @Int @Bool GHC.Internal.Real.$fIntegralInt ($dCTuple2 `cast` (Sub (Sym (SpecTyFam_Import.D:R:MaybeShowNum[0] <Bool>_N <Int>_N)) :: (Show Bool, Num Int) ~R# MaybeShowNum Bool Int)) GHC.Internal.Types.True x + +-- RHS size: {terms: 37, types: 26, coercions: 0, joins: 0/0} +main :: State# RealWorld -> (# State# RealWorld, () #) +[LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 301 0}] +main = \ (eta [OS=OneShot] :: State# RealWorld) -> GHC.Internal.IO.Handle.Text.hPutStr2 GHC.Internal.IO.Handle.FD.stdout (case GHC.Internal.Enum.eftIntFB @(Int -> Int) (GHC.Internal.Base.mapFB @Int @(Int -> Int) @Int (\ (ds :: Int) (ds1 [OS=OneShot] :: Int -> Int) (v [OS=OneShot] :: Int) -> case v of { I# ipv -> ds1 (case ds of { I# y -> GHC.Internal.Types.I# (+# ipv y) }) }) (\ (x :: Int) -> case foo x of { (_ [Occ=Dead], y) -> y })) (breakpoint @Int) 1# 1000# (GHC.Internal.Types.I# 0#) of { I# n -> GHC.Internal.Show.itos n (GHC.Internal.Types.[] @Char) }) GHC.Internal.Types.True eta + +-- RHS size: {terms: 1, types: 0, coercions: 3, joins: 0/0} +main :: IO () +[LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] +main = main `cast` (Sym (GHC.Internal.Types.N:IO <()>_R) :: (State# RealWorld -> (# State# RealWorld, () #)) ~R# IO ()) + + +------ Local rules for imported ids -------- +"SPEC/SpecTyFam $wspecMe @Int @Bool" [2] forall ($dIntegral :: Integral Int) (irred :: MaybeShowNum Bool Int). SpecTyFam_Import.$wspecMe @Int @Bool $dIntegral irred = $s$wspecMe +"SPEC/SpecTyFam specMe @Int @Bool" [2] forall ($dIntegral :: Integral Int) (irred :: MaybeShowNum Bool Int). specMe @Int @Bool $dIntegral irred = $sspecMe + + ===================================== testsuite/tests/simplCore/should_compile/T26051_Import.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ImplicitParams #-} + +module T26051_Import (specMe, MaybeShowNum) where + +import Data.Kind + +type family MaybeShowNum a n :: Constraint where + MaybeShowNum a n = (Show a, Num n) + +{-# INLINABLE specMe #-} +specMe :: (Integral n, MaybeShowNum a n) => a -> n -> (String,n) +specMe s !n = (show s, n+1 `div` 2) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -548,3 +548,9 @@ test('T25965', normal, compile, ['-O']) test('T25703', [grep_errmsg(r'SPEC')], compile, ['-O -fpolymorphic-specialisation -ddump-rule-firings']) test('T25703a', [grep_errmsg(r'SPEC')], compile, ['-O -fpolymorphic-specialisation -ddump-rule-firings']) +# Check that $s$wspecMe doesn't have any dictionary args after specialization in addition to perf stats +test('T26051', [ grep_errmsg(r'\$wspecMe') + , extra_files(['T26051_Import.hs']) + , only_ways(['optasm'])], + multimod_compile, + ['T26051', '-O2 -ddump-spec -dsuppress-uniques -dno-typeable-binds -dppr-cols=1000']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99791506137adb02700d7b291b852a1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99791506137adb02700d7b291b852a1… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/libffi-3.4.8
by Cheng Shao (＠TerrorJack) 22 May '25

22 May '25

Cheng Shao deleted branch wip/libffi-3.4.8 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Implement -Wpattern-namespace-specifier (#25900)
by Marge Bot (＠marge-bot) 21 May '25

21 May '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b1212fbf by Vladislav Zavialov at 2025-05-21T16:01:33-04:00 Implement -Wpattern-namespace-specifier (#25900) In accordance with GHC Proposal #581 "Namespace-specified imports", section 2.3 "Deprecate use of pattern in import/export lists", the `pattern` namespace specifier is now deprecated. Test cases: T25900 T25900_noext - - - - - 56 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/9.14.1-notes.rst - docs/users_guide/using-warnings.rst - hadrian/src/Flavour.hs - libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs - libraries/ghc-internal/src/GHC/Internal/Type/Reflection.hs - libraries/ghc-internal/src/GHC/Internal/TypeLits.hs - libraries/ghc-internal/src/GHC/Internal/TypeNats.hs - testsuite/tests/callarity/unittest/CallArity1.hs - testsuite/tests/ghci/scripts/ghci024.stdout - testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 - + testsuite/tests/parser/should_compile/T25900.hs - + testsuite/tests/parser/should_compile/T25900.stderr - + testsuite/tests/parser/should_compile/T25900_noext.hs - + testsuite/tests/parser/should_compile/T25900_noext.stderr - testsuite/tests/parser/should_compile/all.T - testsuite/tests/patsyn/should_compile/ImpExp_Exp.hs - testsuite/tests/patsyn/should_compile/T11959.hs - testsuite/tests/patsyn/should_compile/T11959.stderr - testsuite/tests/patsyn/should_compile/T11959Lib.hs - testsuite/tests/patsyn/should_compile/T13350/boolean/Boolean.hs - testsuite/tests/patsyn/should_compile/T22521.hs - testsuite/tests/patsyn/should_compile/T9857.hs - testsuite/tests/patsyn/should_compile/export.hs - testsuite/tests/pmcheck/complete_sigs/T25115a.hs - testsuite/tests/pmcheck/should_compile/T11822.hs - testsuite/tests/polykinds/T14270.hs - testsuite/tests/rename/should_compile/T12548.hs - testsuite/tests/rename/should_fail/T25056.stderr - testsuite/tests/rename/should_fail/T25056a.hs - testsuite/tests/simplCore/should_compile/T15186.hs - testsuite/tests/simplCore/should_compile/T15186A.hs - testsuite/tests/typecheck/should_compile/TypeRepCon.hs - testsuite/tests/warnings/should_compile/DataToTagWarnings.hs - testsuite/tests/warnings/should_compile/T14794a.hs - testsuite/tests/warnings/should_compile/T14794a.stderr - testsuite/tests/warnings/should_compile/T14794b.hs - testsuite/tests/warnings/should_compile/T14794b.stderr - testsuite/tests/warnings/should_compile/T14794c.hs - testsuite/tests/warnings/should_compile/T14794c.stderr - testsuite/tests/warnings/should_compile/T14794d.hs - testsuite/tests/warnings/should_compile/T14794d.stderr - testsuite/tests/warnings/should_compile/T14794e.hs - testsuite/tests/warnings/should_compile/T14794e.stderr - testsuite/tests/warnings/should_compile/T14794f.hs - testsuite/tests/warnings/should_compile/T14794f.stderr - testsuite/tests/wcompat-warnings/Template.hs - + testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1212fbfaf7884077386b08a4fedc1d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1212fbfaf7884077386b08a4fedc1d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Don't fail when ghcversion.h can't be found (#26018)
by Marge Bot (＠marge-bot) 21 May '25

21 May '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6d058a69 by Andrea Bedini at 2025-05-21T16:00:51-04:00 Don't fail when ghcversion.h can't be found (#26018) If ghcversion.h can't be found, don't try to include it. This happens when there is no rts package in the package db and when -ghcversion-file argument isn't passed. Co-authored-by: Syvlain Henry <sylvain(a)haskus.fr> - - - - - 4 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/SysTools/Cpp.hs - testsuite/tests/driver/Makefile - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -478,7 +478,7 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do -- very weakly typed, being derived from C--. ["-fno-strict-aliasing"] - ghcVersionH <- getGhcVersionPathName dflags unit_env + ghcVersionH <- getGhcVersionIncludeFlags dflags unit_env withAtomicRename output_fn $ \temp_outputFilename -> GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger tmpfs dflags ( @@ -525,7 +525,7 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do else []) ++ verbFlags ++ cc_opt - ++ [ "-include", ghcVersionH ] + ++ ghcVersionH ++ framework_paths ++ include_paths ++ pkg_extra_cc_opts ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -7,6 +7,7 @@ module GHC.SysTools.Cpp ( doCpp , CppOpts(..) , getGhcVersionPathName + , getGhcVersionIncludeFlags , applyCDefs , offsetIncludePaths ) @@ -31,7 +32,6 @@ import GHC.Utils.TmpFs import GHC.Utils.Panic import Data.Version -import Data.List (intercalate) import Data.Maybe import Control.Monad @@ -124,10 +124,10 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do [homeUnitEnv_dflags . ue_findHomeUnitEnv uid $ unit_env | uid <- ue_transitiveHomeDeps (ue_currentUnit unit_env) unit_env] dep_pkg_extra_inputs = [offsetIncludePaths fs (includePaths fs) | fs <- home_pkg_deps] - let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) [] + let include_paths_global = map ("-I" ++) (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs ++ concatMap includePathsGlobal dep_pkg_extra_inputs) - let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) [] + let include_paths_quote = map ("-iquote" ++) (includePathsQuote cmdline_include_paths ++ includePathsQuoteImplicit cmdline_include_paths) let include_paths = include_paths_quote ++ include_paths_global @@ -178,8 +178,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let asserts_def = [ "-D__GLASGOW_HASKELL_ASSERTS_IGNORED__" | gopt Opt_IgnoreAsserts dflags] -- Default CPP defines in Haskell source - ghcVersionH <- getGhcVersionPathName dflags unit_env - let hsSourceCppOpts = [ "-include", ghcVersionH ] + ghcVersionH <- getGhcVersionIncludeFlags dflags unit_env -- MIN_VERSION macros let uids = explicitUnits unit_state @@ -202,7 +201,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do cpp_prog ( map GHC.SysTools.Option verbFlags ++ map GHC.SysTools.Option include_paths - ++ map GHC.SysTools.Option hsSourceCppOpts + ++ map GHC.SysTools.Option ghcVersionH ++ map GHC.SysTools.Option target_defs ++ map GHC.SysTools.Option backend_defs ++ map GHC.SysTools.Option th_defs @@ -265,28 +264,32 @@ generateMacros prefix name version = _ -> error "take3" (major1,major2,minor) = take3 $ map show (versionBranch version) ++ repeat "0" +getGhcVersionIncludeFlags :: DynFlags -> UnitEnv -> IO [String] +getGhcVersionIncludeFlags dflags unit_env = + getGhcVersionPathName dflags unit_env >>= \case + Nothing -> pure [] + Just path -> pure [ "-include", path ] -- | Find out path to @ghcversion.h@ file -getGhcVersionPathName :: DynFlags -> UnitEnv -> IO FilePath -getGhcVersionPathName dflags unit_env = do - let candidates = case ghcVersionFile dflags of - -- the user has provided an explicit `ghcversion.h` file to use. - Just path -> [path] - -- otherwise, try to find it in the rts' include-dirs. - -- Note: only in the RTS include-dirs! not all preload units less we may - -- use a wrong file. See #25106 where a globally installed - -- /usr/include/ghcversion.h file was used instead of the one provided - -- by the rts. - Nothing -> case lookupUnitId (ue_homeUnitState unit_env) rtsUnitId of - Nothing -> [] - Just info -> (</> "ghcversion.h") <$> collectIncludeDirs [info] - - found <- filterM doesFileExist candidates - case found of - [] -> throwGhcExceptionIO (InstallationError - ("ghcversion.h missing; tried: " - ++ intercalate ", " candidates)) - (x:_) -> return x +getGhcVersionPathName :: DynFlags -> UnitEnv -> IO (Maybe FilePath) +getGhcVersionPathName dflags unit_env = case ghcVersionFile dflags of + -- the user has provided an explicit `ghcversion.h` file to use. + Just path -> doesFileExist path >>= \case + True -> return (Just path) + False -> throwGhcExceptionIO (InstallationError ("ghcversion.h not found in: " ++ path)) + -- otherwise, try to find it in the rts' include-dirs. + -- Note: only in the RTS include-dirs! not all preload units less we may + -- use a wrong file. See #25106 where a globally installed + -- /usr/include/ghcversion.h file was used instead of the one provided + -- by the rts. + Nothing -> case lookupUnitId (ue_homeUnitState unit_env) rtsUnitId of + Nothing -> pure Nothing + Just info -> do + let candidates = (</> "ghcversion.h") <$> collectIncludeDirs [info] + found <- filterM doesFileExist candidates + case found of + [] -> pure Nothing + (x:_) -> pure (Just x) applyCDefs :: DefunctionalizedCDefs -> Logger -> DynFlags -> IO [String] applyCDefs NoCDefs _ _ = return [] ===================================== testsuite/tests/driver/Makefile ===================================== @@ -813,3 +813,8 @@ T23339B: T25382: "$(TEST_HC)" $(TEST_HC_OPTS) -c T25382.hs "$(TEST_HC)" $(TEST_HC_OPTS) T25382.o -o main + +# Test we can compile C code with an empty package DB +T26018: + touch foo.c + "$(TEST_HC)" $(TEST_HC_OPTS) -c foo.c -clear-package-db ===================================== testsuite/tests/driver/all.T ===================================== @@ -331,3 +331,4 @@ test('T24286', [cxx_src, unless(have_profiling(), skip), extra_files(['T24286.cp test('T24839', [unless(arch('x86_64') or arch('aarch64'), skip), extra_files(["t24839_sub.S"])], compile_and_run, ['t24839_sub.S']) test('t25150', [extra_files(["t25150"])], multimod_compile, ['Main.hs', '-v0 -working-dir t25150/dir a.c']) test('T25382', normal, makefile_test, []) +test('T26018', req_c, makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d058a6948ab62deab69d7249a91cf4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d058a6948ab62deab69d7249a91cf4… You're receiving this email because of your account on gitlab.haskell.org.

1 0