Hannes Siebenhandl pushed to branch wip/fendor/stack-annotation-with-backtraces at Glasgow Haskell Compiler / GHC
Commits:
-
022ce2bc
by fendor at 2025-08-13T15:40:03+02:00
5 changed files:
- libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- + libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
Changes:
| ... | ... | @@ -27,29 +27,12 @@ import Data.Typeable |
| 27 | 27 | import GHC.Exts
|
| 28 | 28 | import GHC.IO
|
| 29 | 29 | import GHC.Internal.Stack
|
| 30 | - |
|
| 31 | --- ----------------------------------------------------------------------------
|
|
| 32 | --- StackAnnotation
|
|
| 33 | --- ----------------------------------------------------------------------------
|
|
| 34 | - |
|
| 35 | --- | 'StackAnnotation's are types which can be pushed onto the call stack
|
|
| 36 | --- as the payload of 'AnnFrame' stack frames.
|
|
| 37 | ---
|
|
| 38 | -class StackAnnotation a where
|
|
| 39 | - displayStackAnnotation :: a -> String
|
|
| 30 | +import GHC.Internal.Stack.Annotation
|
|
| 40 | 31 | |
| 41 | 32 | -- ----------------------------------------------------------------------------
|
| 42 | 33 | -- Annotations
|
| 43 | 34 | -- ----------------------------------------------------------------------------
|
| 44 | 35 | |
| 45 | --- |
|
|
| 46 | --- The @SomeStackAnnotation@ type is the root of the stack annotation type hierarchy.
|
|
| 47 | --- When the call stack is annotated with a value of type @a@, behind the scenes it is
|
|
| 48 | --- encapsulated in a @SomeStackAnnotation@.
|
|
| 49 | ---
|
|
| 50 | -data SomeStackAnnotation where
|
|
| 51 | - SomeStackAnnotation :: forall a. (Typeable a, StackAnnotation a) => a -> SomeStackAnnotation
|
|
| 52 | - |
|
| 53 | 36 | instance StackAnnotation SomeStackAnnotation where
|
| 54 | 37 | displayStackAnnotation (SomeStackAnnotation a) = displayStackAnnotation a
|
| 55 | 38 |
| ... | ... | @@ -295,6 +295,7 @@ Library |
| 295 | 295 | GHC.Internal.Stable
|
| 296 | 296 | GHC.Internal.StableName
|
| 297 | 297 | GHC.Internal.Stack
|
| 298 | + GHC.Internal.Stack.Annotation
|
|
| 298 | 299 | GHC.Internal.Stack.CCS
|
| 299 | 300 | GHC.Internal.Stack.CloneStack
|
| 300 | 301 | GHC.Internal.Stack.Constants
|
| ... | ... | @@ -11,7 +11,7 @@ import GHC.Internal.IORef |
| 11 | 11 | import GHC.Internal.IO.Unsafe (unsafePerformIO)
|
| 12 | 12 | import GHC.Internal.Exception.Context
|
| 13 | 13 | import GHC.Internal.Ptr
|
| 14 | -import GHC.Internal.Data.Maybe (fromMaybe)
|
|
| 14 | +import GHC.Internal.Data.Maybe (fromMaybe, mapMaybe)
|
|
| 15 | 15 | import GHC.Internal.Stack.Types as GHC.Stack (CallStack, HasCallStack)
|
| 16 | 16 | import qualified GHC.Internal.Stack as HCS
|
| 17 | 17 | import qualified GHC.Internal.ExecutionStack.Internal as ExecStack
|
| ... | ... | @@ -144,7 +144,7 @@ displayBacktraces bts = concat |
| 144 | 144 | displayExec = unlines . map (indent 2 . flip ExecStack.showLocation "") . fromMaybe [] . ExecStack.stackFrames
|
| 145 | 145 | -- The unsafePerformIO here is safe as 'StackSnapshot' makes sure neither the stack frames nor
|
| 146 | 146 | -- references closures can be garbage collected.
|
| 147 | - displayIpe = unlines . map (indent 2 . CloneStack.prettyStackEntry) . unsafePerformIO . CloneStack.decode
|
|
| 147 | + displayIpe = unlines . mapMaybe (fmap (indent 2) . CloneStack.prettyStackFrameWithIpe) . unsafePerformIO . CloneStack.decodeStackWithIpe
|
|
| 148 | 148 | displayHsc = unlines . map (indent 2 . prettyCallSite) . HCS.getCallStack
|
| 149 | 149 | where prettyCallSite (f, loc) = f ++ ", called at " ++ HCS.prettySrcLoc loc
|
| 150 | 150 |
| 1 | +{-# LANGUAGE GADTs #-}
|
|
| 2 | +{-# LANGUAGE ScopedTypeVariables #-}
|
|
| 3 | +module GHC.Internal.Stack.Annotation where
|
|
| 4 | + |
|
| 5 | +import GHC.Internal.Base
|
|
| 6 | +import GHC.Internal.Data.Typeable
|
|
| 7 | + |
|
| 8 | +-- ----------------------------------------------------------------------------
|
|
| 9 | +-- StackAnnotation
|
|
| 10 | +-- ----------------------------------------------------------------------------
|
|
| 11 | + |
|
| 12 | +-- | 'StackAnnotation's are types which can be pushed onto the call stack
|
|
| 13 | +-- as the payload of 'AnnFrame' stack frames.
|
|
| 14 | +--
|
|
| 15 | +class StackAnnotation a where
|
|
| 16 | + displayStackAnnotation :: a -> String
|
|
| 17 | + |
|
| 18 | +-- ----------------------------------------------------------------------------
|
|
| 19 | +-- Annotations
|
|
| 20 | +-- ----------------------------------------------------------------------------
|
|
| 21 | + |
|
| 22 | +-- |
|
|
| 23 | +-- The @SomeStackAnnotation@ type is the root of the stack annotation type hierarchy.
|
|
| 24 | +-- When the call stack is annotated with a value of type @a@, behind the scenes it is
|
|
| 25 | +-- encapsulated in a @SomeStackAnnotation@.
|
|
| 26 | +--
|
|
| 27 | +data SomeStackAnnotation where
|
|
| 28 | + SomeStackAnnotation :: forall a. (Typeable a, StackAnnotation a) => a -> SomeStackAnnotation |
| ... | ... | @@ -4,6 +4,7 @@ |
| 4 | 4 | {-# LANGUAGE FlexibleInstances #-}
|
| 5 | 5 | {-# LANGUAGE GHCForeignImportPrim #-}
|
| 6 | 6 | {-# LANGUAGE MagicHash #-}
|
| 7 | +{-# LANGUAGE NamedFieldPuns #-}
|
|
| 7 | 8 | {-# LANGUAGE RankNTypes #-}
|
| 8 | 9 | {-# LANGUAGE RecordWildCards #-}
|
| 9 | 10 | {-# LANGUAGE ScopedTypeVariables #-}
|
| ... | ... | @@ -40,6 +41,7 @@ import GHC.Internal.Data.Tuple |
| 40 | 41 | import GHC.Internal.Foreign.Ptr
|
| 41 | 42 | import GHC.Internal.Foreign.Storable
|
| 42 | 43 | import GHC.Internal.Exts
|
| 44 | +import GHC.Internal.Unsafe.Coerce
|
|
| 43 | 45 | |
| 44 | 46 | import GHC.Internal.ClosureTypes
|
| 45 | 47 | import GHC.Internal.Heap.Closures
|
| ... | ... | @@ -53,6 +55,7 @@ import GHC.Internal.Heap.Closures |
| 53 | 55 | )
|
| 54 | 56 | import GHC.Internal.Heap.Constants (wORD_SIZE_IN_BITS)
|
| 55 | 57 | import GHC.Internal.Heap.InfoTable
|
| 58 | +import GHC.Internal.Stack.Annotation
|
|
| 56 | 59 | import GHC.Internal.Stack.Constants
|
| 57 | 60 | import GHC.Internal.Stack.CloneStack
|
| 58 | 61 | import GHC.Internal.InfoProv.Types (InfoProv (..), ipLoc, lookupIPE)
|
| ... | ... | @@ -443,7 +446,7 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi |
| 443 | 446 | ANN_FRAME ->
|
| 444 | 447 | let annotation = getClosureBox stackSnapshot# (index + offsetStgAnnFrameAnn)
|
| 445 | 448 | in
|
| 446 | - mkStackFrameResult $
|
|
| 449 | + mkStackFrameResult $
|
|
| 447 | 450 | AnnFrame
|
| 448 | 451 | { info_tbl = info,
|
| 449 | 452 | annotation = annotation
|
| ... | ... | @@ -561,9 +564,16 @@ decodeStackWithFrameUnpack unpackFrame (StackSnapshot stack#) = do |
| 561 | 564 | -- Pretty printing functions for stack entires, stack frames and provenance info
|
| 562 | 565 | -- ----------------------------------------------------------------------------
|
| 563 | 566 | |
| 567 | + |
|
| 564 | 568 | prettyStackFrameWithIpe :: (StackFrame, Maybe InfoProv) -> Maybe String
|
| 565 | -prettyStackFrameWithIpe (_frame, mipe) =
|
|
| 566 | - (prettyStackEntry . toStackEntry) <$> mipe
|
|
| 569 | +prettyStackFrameWithIpe (frame, mipe) =
|
|
| 570 | + case frame of
|
|
| 571 | + AnnFrame {annotation = Box someStackAnno } ->
|
|
| 572 | + case unsafeCoerce someStackAnno of
|
|
| 573 | + SomeStackAnnotation ann ->
|
|
| 574 | + Just $ displayStackAnnotation ann
|
|
| 575 | + _ ->
|
|
| 576 | + (prettyStackEntry . toStackEntry) <$> mipe
|
|
| 567 | 577 | |
| 568 | 578 | prettyStackEntry :: StackEntry -> String
|
| 569 | 579 | prettyStackEntry (StackEntry {moduleName=mod_nm, functionName=fun_nm, srcLoc=loc}) =
|