update to current master againwip/T13904

2 files changed, 34 insertions, 13 deletions

diff --git a/libraries/base/GHC/Stack/CCS.hsc b/libraries/base/GHC/Stack/CCS.hsc
index 51eb6244a4..ba384a13b4 100644
--- a/libraries/base/GHC/Stack/CCS.hsc
+++ b/libraries/base/GHC/Stack/CCS.hsc
@@ -48,34 +48,50 @@ import GHC.List ( concatMap, reverse )
 #define PROFILING
 #include "Rts.h"
 
+-- | A cost-centre stack from GHC's cost-center profiler.
 data CostCentreStack
+
+-- | A cost-centre from GHC's cost-center profiler.
 data CostCentre
 
+-- | Returns the current 'CostCentreStack' (value is @nullPtr@ if the current
+-- program was not compiled with profiling support). Takes a dummy argument
+-- which can be used to avoid the call to @getCurrentCCS@ being floated out by
+-- the simplifier, which would result in an uninformative stack ("CAF").
 getCurrentCCS :: dummy -> IO (Ptr CostCentreStack)
 getCurrentCCS dummy = IO $ \s ->
    case getCurrentCCS## dummy s of
      (## s', addr ##) -> (## s', Ptr addr ##)
 
+-- | Get the 'CostCentreStack' associated with the given value.
 getCCSOf :: a -> IO (Ptr CostCentreStack)
 getCCSOf obj = IO $ \s ->
    case getCCSOf## obj s of
      (## s', addr ##) -> (## s', Ptr addr ##)
 
+-- | Run a computation with an empty cost-center stack. For example, this is
+-- used by the interpreter to run an interpreted computation without the call
+-- stack showing that it was invoked from GHC.
 clearCCS :: IO a -> IO a
 clearCCS (IO m) = IO $ \s -> clearCCS## m s
 
+-- | Get the 'CostCentre' at the head of a 'CostCentreStack'.
 ccsCC :: Ptr CostCentreStack -> IO (Ptr CostCentre)
 ccsCC p = (# peek CostCentreStack, cc) p
 
+-- | Get the tail of a 'CostCentreStack'.
 ccsParent :: Ptr CostCentreStack -> IO (Ptr CostCentreStack)
 ccsParent p = (# peek CostCentreStack, prevStack) p
 
+-- | Get the label of a 'CostCentre'.
 ccLabel :: Ptr CostCentre -> IO CString
 ccLabel p = (# peek CostCentre, label) p
 
+-- | Get the module of a 'CostCentre'.
 ccModule :: Ptr CostCentre -> IO CString
 ccModule p = (# peek CostCentre, module) p
 
+-- | Get the source span of a 'CostCentre'.
 ccSrcSpan :: Ptr CostCentre -> IO CString
 ccSrcSpan p = (# peek CostCentre, srcloc) p
 
@@ -92,6 +108,7 @@ ccSrcSpan p = (# peek CostCentre, srcloc) p
 currentCallStack :: IO [String]
 currentCallStack = ccsToStrings =<< getCurrentCCS ()
 
+-- | Format a 'CostCentreStack' as a list of lines.
 ccsToStrings :: Ptr CostCentreStack -> IO [String]
 ccsToStrings ccs0 = go ccs0 []
   where
diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs
index 54352b19de..45b11216a5 100644
--- a/libraries/base/GHC/Stack/Types.hs
+++ b/libraries/base/GHC/Stack/Types.hs
@@ -51,8 +51,9 @@ import GHC.Classes (Eq)
 import GHC.Types (Char, Int)
 
 -- Make implicit dependency known to build system
-import GHC.Tuple ()
-import GHC.Integer ()
+import GHC.Tuple ()   -- See Note [Depend on GHC.Tuple] in GHC.Base
+import GHC.Integer () -- See Note [Depend on GHC.Integer] in GHC.Base
+import GHC.Natural () -- See Note [Depend on GHC.Natural] in GHC.Base
 
 ----------------------------------------------------------------------
 -- Explicit call-stacks built via ImplicitParams
@@ -75,25 +76,28 @@ type HasCallStack = (?callStack :: CallStack)
 -- For example, we can define
 --
 -- @
--- errorWithCallStack :: HasCallStack => String -> a
+-- putStrLnWithCallStack :: HasCallStack => String -> IO ()
 -- @
 --
--- as a variant of @error@ that will get its call-site. We can access the
--- call-stack inside @errorWithCallStack@ with 'GHC.Stack.callStack'.
+-- as a variant of @putStrLn@ that will get its call-site and print it,
+-- along with the string given as argument. We can access the
+-- call-stack inside @putStrLnWithCallStack@ with 'GHC.Stack.callStack'.
 --
 -- @
--- errorWithCallStack :: HasCallStack => String -> a
--- errorWithCallStack msg = error (msg ++ "\n" ++ prettyCallStack callStack)
+-- putStrLnWithCallStack :: HasCallStack => String -> IO ()
+-- putStrLnWithCallStack msg = do
+--   putStrLn msg
+--   putStrLn (prettyCallStack callStack)
 -- @
 --
--- Thus, if we call @errorWithCallStack@ we will get a formatted call-stack
--- alongside our error message.
+-- Thus, if we call @putStrLnWithCallStack@ we will get a formatted call-stack
+-- alongside our string.
 --
 --
--- >>> errorWithCallStack "die"
--- *** Exception: die
+-- >>> putStrLnWithCallStack "hello"
+-- hello
 -- CallStack (from HasCallStack):
---   errorWithCallStack, called at <interactive>:2:1 in interactive:Ghci1
+--   putStrLnWithCallStack, called at <interactive>:2:1 in interactive:Ghci1
 --
 --
 -- GHC solves 'HasCallStack' constraints in three steps:
@@ -212,4 +216,4 @@ data SrcLoc = SrcLoc
   , srcLocStartCol  :: Int
   , srcLocEndLine   :: Int
   , srcLocEndCol    :: Int
-  } deriving Eq
+  } deriving Eq -- ^ @since 4.9.0.0