Hannes Siebenhandl pushed to branch wip/fendor/stack-annotation-with-backtraces at Glasgow Haskell Compiler / GHC

Commits:

9 changed files:

Changes:

  • libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
    ... ... @@ -58,6 +58,7 @@ import Data.Typeable
    58 58 
     import GHC.Exts
    59 59 
     import GHC.IO
    60 60 
     import GHC.Internal.Stack
    61 
    +import GHC.Internal.Stack.Annotation
    61 62
    62 63 
     -- Note [User-defined stack annotations for better stack traces]
    63 64 
     -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ... ... @@ -127,31 +128,10 @@ import GHC.Internal.Stack
    127 128 
     -- This means, right now, if you want to reliably capture stack frame annotations,
    128 129 
     -- in both pure and impure code, prefer 'throw' and 'throwIO' variants over 'error'.
    129 130
    130 
    --- ----------------------------------------------------------------------------
    131 
    --- StackAnnotation
    132 
    --- ----------------------------------------------------------------------------
    133 
    -
    134 
    --- | 'StackAnnotation's are types which can be pushed onto the call stack
    135 
    --- as the payload of 'AnnFrame' stack frames.
    136 
    ---
    137 
    -class StackAnnotation a where
    138 
    -  displayStackAnnotation :: a -> String
    139 
    -
    140 131 
     -- ----------------------------------------------------------------------------
    141 132 
     -- Annotations
    142 133 
     -- ----------------------------------------------------------------------------
    143 134
    144 
    --- |
    145 
    --- The @SomeStackAnnotation@ type is the root of the stack annotation type hierarchy.
    146 
    --- When the call stack is annotated with a value of type @a@, behind the scenes it is
    147 
    --- encapsulated in a @SomeStackAnnotation@.
    148 
    ---
    149 
    -data SomeStackAnnotation where
    150 
    -  SomeStackAnnotation :: forall a. (Typeable a, StackAnnotation a) => a -> SomeStackAnnotation
    151 
    -
    152 
    -instance StackAnnotation SomeStackAnnotation where
    153 
    -  displayStackAnnotation (SomeStackAnnotation a) = displayStackAnnotation a
    154 
    -
    155 135 
     data StringAnnotation where
    156 136 
       StringAnnotation :: String -> StringAnnotation
    157 137
    ... ... @@ -175,7 +155,7 @@ instance Show CallStackAnnotation where
    175 155 
     instance StackAnnotation CallStackAnnotation where
    176 156 
       displayStackAnnotation (CallStackAnnotation cs) = case getCallStack cs of
    177 157 
         [] -> "<unknown source location>"
    178 
    -    ((_,srcLoc):_) -> prettySrcLoc srcLoc
    158 
    +    ((fnName,srcLoc):_) -> fnName ++ ", called at " ++ prettySrcLoc srcLoc
    179 159
    180 160 
     -- ----------------------------------------------------------------------------
    181 161 
     -- Annotate the CallStack with custom data

  • libraries/ghc-internal/ghc-internal.cabal.in
    ... ... @@ -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

  • libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
    ... ... @@ -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

  • libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
    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
    29 
    +
    30 
    +instance StackAnnotation SomeStackAnnotation where
    31 
    +  displayStackAnnotation (SomeStackAnnotation a) = displayStackAnnotation a

  • libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
    ... ... @@ -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 #-}
    ... ... @@ -23,6 +24,7 @@ module GHC.Internal.Stack.Decode (
    23 24 
       StackEntry(..),
    24 25 
       -- * Pretty printing
    25 26 
       prettyStackEntry,
    27 
    +  prettyStackFrameWithIpe,
    26 28 
       )
    27 29 
     where
    28 30
    ... ... @@ -39,6 +41,7 @@ import GHC.Internal.Data.Tuple
    39 41 
     import GHC.Internal.Foreign.Ptr
    40 42 
     import GHC.Internal.Foreign.Storable
    41 43 
     import GHC.Internal.Exts
    44 
    +import GHC.Internal.Unsafe.Coerce
    42 45
    43 46 
     import GHC.Internal.ClosureTypes
    44 47 
     import GHC.Internal.Heap.Closures
    ... ... @@ -52,6 +55,7 @@ import GHC.Internal.Heap.Closures
    52 55 
       )
    53 56 
     import GHC.Internal.Heap.Constants (wORD_SIZE_IN_BITS)
    54 57 
     import GHC.Internal.Heap.InfoTable
    58 
    +import GHC.Internal.Stack.Annotation
    55 59 
     import GHC.Internal.Stack.Constants
    56 60 
     import GHC.Internal.Stack.CloneStack
    57 61 
     import GHC.Internal.InfoProv.Types (InfoProv (..), ipLoc, lookupIPE)
    ... ... @@ -560,6 +564,16 @@ decodeStackWithFrameUnpack unpackFrame (StackSnapshot stack#) = do
    560 564 
     -- Pretty printing functions for stack entires, stack frames and provenance info
    561 565 
     -- ----------------------------------------------------------------------------
    562 566
    567 
    +prettyStackFrameWithIpe :: (StackFrame, Maybe InfoProv) -> Maybe String
    568 
    +prettyStackFrameWithIpe (frame, mipe) =
    569 
    +  case frame of
    570 
    +    AnnFrame {annotation = Box someStackAnno } ->
    571 
    +      case unsafeCoerce someStackAnno of
    572 
    +        SomeStackAnnotation ann ->
    573 
    +          Just $ displayStackAnnotation ann
    574 
    +    _ ->
    575 
    +      (prettyStackEntry . toStackEntry) <$> mipe
    576 
    +
    563 577 
     prettyStackEntry :: StackEntry -> String
    564 578 
     prettyStackEntry (StackEntry {moduleName=mod_nm, functionName=fun_nm, srcLoc=loc}) =
    565 579 
       mod_nm ++ "." ++ fun_nm ++ " (" ++ loc ++ ")"

  • libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout
    1 1 
     Start some work
    2 2 
     10946
    3 3 
     Stack annotations:
    4 
    -- ann_frame002.hs:18:7 in main:Main
    5 
    -- ann_frame002.hs:12:11 in main:Main
    4 
    +- annotateCallStackIO, called at ann_frame002.hs:18:7 in main:Main
    5 
    +- annotateCallStackIO, called at ann_frame002.hs:12:11 in main:Main
    6 6 
     Finish some work
    7 7 
     Some more work in bar
    8 8 
     17711
    9 9 
     Stack annotations:
    10 10 
     - bar
    11 
    -- ann_frame002.hs:23:7 in main:Main
    11 
    +- annotateCallStackIO, called at ann_frame002.hs:23:7 in main:Main

  • libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout
    1 1 
     Stack annotations:
    2 
    -- ann_frame004.hs:21:17 in main:Main
    3 
    -- ann_frame004.hs:21:17 in main:Main
    4 
    -- ann_frame004.hs:21:17 in main:Main
    5 
    -- ann_frame004.hs:21:17 in main:Main
    6 
    -- ann_frame004.hs:21:17 in main:Main
    7 
    -- ann_frame004.hs:21:17 in main:Main
    8 
    -- ann_frame004.hs:21:17 in main:Main
    9 
    -- ann_frame004.hs:21:17 in main:Main
    10 
    -- ann_frame004.hs:21:17 in main:Main
    11 
    -- ann_frame004.hs:21:17 in main:Main
    12 
    -- ann_frame004.hs:21:17 in main:Main
    13 
    -- ann_frame004.hs:21:17 in main:Main
    14 
    -- ann_frame004.hs:21:17 in main:Main
    15 
    -- ann_frame004.hs:13:10 in main:Main
    2 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    3 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    4 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    5 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    6 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    7 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    8 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    9 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    10 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    11 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    12 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    13 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    14 
    +- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
    15 
    +- annotateCallStack, called at ann_frame004.hs:13:10 in main:Main
    16 16 
     - bar
    17 
    -- ann_frame004.hs:12:7 in main:Main
    17 
    +- annotateCallStackIO, called at ann_frame004.hs:12:7 in main:Main

  • testsuite/tests/interface-stability/ghc-experimental-exports.stdout
    ... ... @@ -10949,10 +10949,6 @@ module System.Mem.Experimental where
    10949 10949
    10950 10950
    10951 10951 
     -- Instances:
    10952 
    -instance GHC.Stack.Annotation.Experimental.StackAnnotation GHC.Stack.Annotation.Experimental.CallStackAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    10953 
    -instance GHC.Stack.Annotation.Experimental.StackAnnotation GHC.Stack.Annotation.Experimental.ShowAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    10954 
    -instance GHC.Stack.Annotation.Experimental.StackAnnotation GHC.Stack.Annotation.Experimental.SomeStackAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    10955 
    -instance GHC.Stack.Annotation.Experimental.StackAnnotation GHC.Stack.Annotation.Experimental.StringAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    10956 10952 
     instance GHC.Internal.Base.Alternative GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.Base’
    10957 10953 
     instance GHC.Internal.Base.Alternative [] -- Defined in ‘GHC.Internal.Base’
    10958 10954 
     instance GHC.Internal.Base.Alternative GHC.Internal.Maybe.Maybe -- Defined in ‘GHC.Internal.Base’
    ... ... @@ -11151,3 +11147,7 @@ instance GHC.Internal.Show.Show GHC.Internal.IO.SubSystem.IoSubSystem -- Defined
    11151 11147 
     instance GHC.Internal.Show.Show GHC.Stack.Annotation.Experimental.CallStackAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    11152 11148 
     instance GHC.Internal.Show.Show GHC.Internal.Stats.GCDetails -- Defined in ‘GHC.Internal.Stats’
    11153 11149 
     instance GHC.Internal.Show.Show GHC.Internal.Stats.RTSStats -- Defined in ‘GHC.Internal.Stats’
    11150 
    +instance GHC.Internal.Stack.Annotation.StackAnnotation GHC.Stack.Annotation.Experimental.CallStackAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    11151 
    +instance GHC.Internal.Stack.Annotation.StackAnnotation GHC.Stack.Annotation.Experimental.ShowAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    11152 
    +instance GHC.Internal.Stack.Annotation.StackAnnotation GHC.Stack.Annotation.Experimental.StringAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    11153 
    +instance GHC.Internal.Stack.Annotation.StackAnnotation GHC.Internal.Stack.Annotation.SomeStackAnnotation -- Defined in ‘GHC.Internal.Stack.Annotation’

  • testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
    ... ... @@ -10952,10 +10952,6 @@ module System.Mem.Experimental where
    10952 10952
    10953 10953
    10954 10954 
     -- Instances:
    10955 
    -instance GHC.Stack.Annotation.Experimental.StackAnnotation GHC.Stack.Annotation.Experimental.CallStackAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    10956 
    -instance GHC.Stack.Annotation.Experimental.StackAnnotation GHC.Stack.Annotation.Experimental.ShowAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    10957 
    -instance GHC.Stack.Annotation.Experimental.StackAnnotation GHC.Stack.Annotation.Experimental.SomeStackAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    10958 
    -instance GHC.Stack.Annotation.Experimental.StackAnnotation GHC.Stack.Annotation.Experimental.StringAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    10959 10955 
     instance GHC.Internal.Base.Alternative GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.Base’
    10960 10956 
     instance GHC.Internal.Base.Alternative [] -- Defined in ‘GHC.Internal.Base’
    10961 10957 
     instance GHC.Internal.Base.Alternative GHC.Internal.Maybe.Maybe -- Defined in ‘GHC.Internal.Base’
    ... ... @@ -11154,3 +11150,7 @@ instance GHC.Internal.Show.Show GHC.Internal.IO.SubSystem.IoSubSystem -- Defined
    11154 11150 
     instance GHC.Internal.Show.Show GHC.Stack.Annotation.Experimental.CallStackAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    11155 11151 
     instance GHC.Internal.Show.Show GHC.Internal.Stats.GCDetails -- Defined in ‘GHC.Internal.Stats’
    11156 11152 
     instance GHC.Internal.Show.Show GHC.Internal.Stats.RTSStats -- Defined in ‘GHC.Internal.Stats’
    11153 
    +instance GHC.Internal.Stack.Annotation.StackAnnotation GHC.Stack.Annotation.Experimental.CallStackAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    11154 
    +instance GHC.Internal.Stack.Annotation.StackAnnotation GHC.Stack.Annotation.Experimental.ShowAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    11155 
    +instance GHC.Internal.Stack.Annotation.StackAnnotation GHC.Stack.Annotation.Experimental.StringAnnotation -- Defined in ‘GHC.Stack.Annotation.Experimental’
    11156 
    +instance GHC.Internal.Stack.Annotation.StackAnnotation GHC.Internal.Stack.Annotation.SomeStackAnnotation -- Defined in ‘GHC.Internal.Stack.Annotation’

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help