From 865dd6a49089fdbc823443be032b860a76d580cf Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Tue, 6 Jun 2023 09:47:42 +0100
Subject: [PATCH] Add support for orig_thunk_info closures
---
ghc-debug-brick/src/Lib.hs | 25 +++++++++++++++++--------
1 file changed, 17 insertions(+), 8 deletions(-)
diff --git a/ghc-debug-brick/src/Lib.hs b/ghc-debug-brick/src/Lib.hs
index 2571b4d..957c780 100644
--- a/ghc-debug-brick/src/Lib.hs
+++ b/ghc-debug-brick/src/Lib.hs
@@ -342,16 +342,25 @@ closureReferences e (Stack _ stack) = run e $ do
let action (GD.SPtr ptr) = ("Pointer", ListFullClosure . Closure ptr <$> GD.dereferenceClosure ptr)
action (GD.SNonPtr dat) = ("Data:" ++ show dat, return ListData)
- frame_items frame = ("Info: " ++ show (tableId (frame_info frame)), return (ListOnlyInfo (tableId (frame_info frame)))) :
- [ ("SRT: ", ListFullClosure . Closure srt <$> GD.dereferenceClosure srt) | Just srt <- [getSrt (frame_srt frame)]]
- ++ map action (GD.values frame)
+-- frame_items :: DebugStackFrame
+-- (GenSrtPayload ClosurePtr) ClosurePtr -> GD.DebugM [(String, _)]
+ frame_items frame = do
+ info <- GD.getSourceInfo (tableId (frame_info frame))
+ case info of
+ Just (SourceInformation {infoName = "stg_orig_thunk_info_frame_info"}) ->
+ let [GD.SNonPtr dat] = GD.values frame
+ in return [("Blackhole arising from thunk:", (ListOnlyInfo (InfoTablePtr dat)))]
+ _ -> traverse sequenceA $
+
+ ("Info: " ++ show (tableId (frame_info frame)), return (ListOnlyInfo (tableId (frame_info frame)))) :
+ [ ("SRT: ", ListFullClosure . Closure srt <$> GD.dereferenceClosure srt) | Just srt <- [getSrt (frame_srt frame)]]
+ ++ map action (GD.values frame)
add_frame_ix ix (lbl, x) = ("Frame " ++ show ix ++ " " ++ lbl, x)
- let lblAndPtrs = [ map (add_frame_ix frameIx) (frame_items frame)
- | (frameIx, frame) <- zip [(0::Int)..] (GD.getFrames stack')
- ]
--- traverse GD.dereferenceClosures (snd <$> lblAndPtrs)
- traverse (traverse id) (concat lblAndPtrs)
+ lblAndPtrs <- sequence [ map (add_frame_ix frameIx) <$> (frame_items frame)
+ | (frameIx, frame) <- zip [(0::Int)..] (GD.getFrames stack')
+ ]
+ return (concat lblAndPtrs)
{-
return $ zipWith (\(lbl,ptr) c -> (lbl, Closure ptr c))
lblAndPtrs
--
GitLab