Make 'error' include the CCS call stack when profiled

Summary:
The idea here is that this gives a more detailed stack trace in two
cases:

1. With `-prof` and `-fprof-auto`
2. In GHCi (see #11047)

Example, with an error inserted in nofib/shootout/binary-trees:

```
$ ./Main 3
Main: z
CallStack (from ImplicitParams):
  error, called at Main.hs:67:29 in main:Main
CallStack (from -prof):
  Main.check' (Main.hs:(67,1)-(68,82))
  Main.check (Main.hs:63:1-21)
  Main.stretch (Main.hs:32:35-57)
  Main.main.c (Main.hs:32:9-57)
  Main.main (Main.hs:(27,1)-(43,42))
  Main.CAF (<entire-module>)
```

This doesn't quite obsolete +RTS -xc, which also attempts to display
more information in the case when the error is in a CAF, but I'm
exploring other solutions to that.

Includes submodule updates.

Test Plan: validate

Reviewers: simonpj, ezyang, gridaphobe, bgamari, hvr, austin

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1426

48 files changed, 465 insertions, 229 deletions

diff --git a/libraries/array b/libraries/array
-Subproject dd75c73d191b3f07209c38f78ebe9dcc26fc5ed
+Subproject 4b43c95af80ed7e1567244527e5e459912d3e50
diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs
index 20b487cc9c..c31a203f9b 100644
--- a/libraries/base/GHC/Exception.hs
+++ b/libraries/base/GHC/Exception.hs
@@ -38,6 +38,9 @@ import Data.Typeable (Typeable, cast)
 import GHC.Base
 import GHC.Show
 import GHC.Stack.Types
+import GHC.OldList
+import GHC.IO.Unsafe
+import {-# SOURCE #-} GHC.Stack.CCS
 
 {- |
 The @SomeException@ type is the root of the exception type hierarchy.
@@ -180,9 +183,17 @@ errorCallException :: String -> SomeException
 errorCallException s = toException (ErrorCall s)
 
 errorCallWithCallStackException :: String -> CallStack -> SomeException
-errorCallWithCallStackException s stk
-  = toException (ErrorCallWithLocation s (showCallStack (popCallStack stk)))
-
+errorCallWithCallStackException s stk = unsafeDupablePerformIO $ do
+  ccsStack <- currentCallStack
+  let
+    implicitParamCallStack = showCallStackLines (popCallStack stk)
+    ccsCallStack = showCCSStack ccsStack
+    stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack
+  return $ toException (ErrorCallWithLocation s stack)
+
+showCCSStack :: [String] -> [String]
+showCCSStack [] = []
+showCCSStack stk = "CallStack (from -prof):" : map ("  " ++) (reverse stk)
 
 -- | Pretty print 'SrcLoc'
 --
@@ -200,17 +211,13 @@ showSrcLoc SrcLoc {..}
 --
 -- @since 4.9.0.0
 showCallStack :: CallStack -> String
-showCallStack (CallStack stk@(_:_))
-  = unlines ("CallStack:" : map (indent . showCallSite) stk)
-  where
-  -- Data.OldList isn't available yet, so we repeat the definition here
-  unlines [] = []
-  unlines [l] = l
-  unlines (l:ls) = l ++ '\n' : unlines ls
-  indent l = "  " ++ l
-  showCallSite (f, loc) = f ++ ", called at " ++ showSrcLoc loc
-showCallStack _ = error "CallStack cannot be empty!"
+showCallStack = intercalate "\n" . showCallStackLines
 
+showCallStackLines :: CallStack -> [String]
+showCallStackLines (CallStack stk) =
+    "CallStack (from ImplicitParams):" : map (("  " ++) . showCallSite) stk
+  where
+    showCallSite (f, loc) = f ++ ", called at " ++ showSrcLoc loc
 
 -- | Remove the most recent callsite from the 'CallStack'
 --
diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs
index f38c88f009..186f6c65c5 100644
--- a/libraries/base/GHC/IO.hs
+++ b/libraries/base/GHC/IO.hs
@@ -44,6 +44,7 @@ import GHC.Base
 import GHC.ST
 import GHC.Exception
 import GHC.Show
+import GHC.IO.Unsafe
 
 import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )
 
@@ -101,160 +102,6 @@ unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s
 unsafeSTToIO :: ST s a -> IO a
 unsafeSTToIO (ST m) = IO (unsafeCoerce# m)
 
--- ---------------------------------------------------------------------------
--- Unsafe IO operations
-
-{-|
-This is the \"back door\" into the 'IO' monad, allowing
-'IO' computation to be performed at any time.  For
-this to be safe, the 'IO' computation should be
-free of side effects and independent of its environment.
-
-If the I\/O computation wrapped in 'unsafePerformIO' performs side
-effects, then the relative order in which those side effects take
-place (relative to the main I\/O trunk, or other calls to
-'unsafePerformIO') is indeterminate.  Furthermore, when using
-'unsafePerformIO' to cause side-effects, you should take the following
-precautions to ensure the side effects are performed as many times as
-you expect them to be.  Note that these precautions are necessary for
-GHC, but may not be sufficient, and other compilers may require
-different precautions:
-
-  * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@
-        that calls 'unsafePerformIO'.  If the call is inlined,
-        the I\/O may be performed more than once.
-
-  * Use the compiler flag @-fno-cse@ to prevent common sub-expression
-        elimination being performed on the module, which might combine
-        two side effects that were meant to be separate.  A good example
-        is using multiple global variables (like @test@ in the example below).
-
-  * Make sure that the either you switch off let-floating (@-fno-full-laziness@), or that the
-        call to 'unsafePerformIO' cannot float outside a lambda.  For example,
-        if you say:
-        @
-           f x = unsafePerformIO (newIORef [])
-        @
-        you may get only one reference cell shared between all calls to @f@.
-        Better would be
-        @
-           f x = unsafePerformIO (newIORef [x])
-        @
-        because now it can't float outside the lambda.
-
-It is less well known that
-'unsafePerformIO' is not type safe.  For example:
-
->     test :: IORef [a]
->     test = unsafePerformIO $ newIORef []
->
->     main = do
->             writeIORef test [42]
->             bang <- readIORef test
->             print (bang :: [Char])
-
-This program will core dump.  This problem with polymorphic references
-is well known in the ML community, and does not arise with normal
-monadic use of references.  There is no easy way to make it impossible
-once you use 'unsafePerformIO'.  Indeed, it is
-possible to write @coerce :: a -> b@ with the
-help of 'unsafePerformIO'.  So be careful!
--}
-unsafePerformIO :: IO a -> a
-unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)
-
-{-|
-This version of 'unsafePerformIO' is more efficient
-because it omits the check that the IO is only being performed by a
-single thread.  Hence, when you use 'unsafeDupablePerformIO',
-there is a possibility that the IO action may be performed multiple
-times (on a multiprocessor), and you should therefore ensure that
-it gives the same results each time. It may even happen that one
-of the duplicated IO actions is only run partially, and then interrupted
-in the middle without an exception being raised. Therefore, functions
-like 'bracket' cannot be used safely within 'unsafeDupablePerformIO'.
-
-@since 4.4.0.0
--}
-unsafeDupablePerformIO  :: IO a -> a
-unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> a
-
--- Note [unsafeDupablePerformIO is NOINLINE]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- Why do we NOINLINE unsafeDupablePerformIO?  See the comment with
--- GHC.ST.runST.  Essentially the issue is that the IO computation
--- inside unsafePerformIO must be atomic: it must either all run, or
--- not at all.  If we let the compiler see the application of the IO
--- to realWorld#, it might float out part of the IO.
-
--- Note [unsafeDupablePerformIO has a lazy RHS]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- Why is there a call to 'lazy' in unsafeDupablePerformIO?
--- If we don't have it, the demand analyser discovers the following strictness
--- for unsafeDupablePerformIO:  C(U(AV))
--- But then consider
---      unsafeDupablePerformIO (\s -> let r = f x in
---                             case writeIORef v r s of (# s1, _ #) ->
---                             (# s1, r #) )
--- The strictness analyser will find that the binding for r is strict,
--- (because of uPIO's strictness sig), and so it'll evaluate it before
--- doing the writeIORef.  This actually makes libraries/base/tests/memo002
--- get a deadlock, where we specifically wanted to write a lazy thunk
--- into the ref cell.
---
--- Solution: don't expose the strictness of unsafeDupablePerformIO,
---           by hiding it with 'lazy'
--- But see discussion in Trac #9390 (comment:33)
-
-{-|
-'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
-When passed a value of type @IO a@, the 'IO' will only be performed
-when the value of the @a@ is demanded.  This is used to implement lazy
-file reading, see 'System.IO.hGetContents'.
--}
-{-# INLINE unsafeInterleaveIO #-}
-unsafeInterleaveIO :: IO a -> IO a
-unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
-
--- We used to believe that INLINE on unsafeInterleaveIO was safe,
--- because the state from this IO thread is passed explicitly to the
--- interleaved IO, so it cannot be floated out and shared.
---
--- HOWEVER, if the compiler figures out that r is used strictly here,
--- then it will eliminate the thunk and the side effects in m will no
--- longer be shared in the way the programmer was probably expecting,
--- but can be performed many times.  In #5943, this broke our
--- definition of fixIO, which contains
---
---    ans <- unsafeInterleaveIO (takeMVar m)
---
--- after inlining, we lose the sharing of the takeMVar, so the second
--- time 'ans' was demanded we got a deadlock.  We could fix this with
--- a readMVar, but it seems wrong for unsafeInterleaveIO to sometimes
--- share and sometimes not (plus it probably breaks the noDuplicate).
--- So now, we do not inline unsafeDupableInterleaveIO.
-
-{-# NOINLINE unsafeDupableInterleaveIO #-}
-unsafeDupableInterleaveIO :: IO a -> IO a
-unsafeDupableInterleaveIO (IO m)
-  = IO ( \ s -> let
-                   r = case m s of (# _, res #) -> res
-                in
-                (# s, r #))
-
-{-|
-Ensures that the suspensions under evaluation by the current thread
-are unique; that is, the current thread is not evaluating anything
-that is also under evaluation by another thread that has also executed
-'noDuplicate'.
-
-This operation is used in the definition of 'unsafePerformIO' to
-prevent the IO action from being executed multiple times, which is usually
-undesirable.
--}
-noDuplicate :: IO ()
-noDuplicate = IO $ \s -> case noDuplicate# s of s' -> (# s', () #)
-
 -- -----------------------------------------------------------------------------
 -- | File and directory names are values of type 'String', whose precise
 -- meaning is operating system dependent. Files can be opened, yielding a
diff --git a/libraries/base/GHC/IO/Unsafe.hs b/libraries/base/GHC/IO/Unsafe.hs
new file mode 100644
index 0000000000..5bb982421b
--- /dev/null
+++ b/libraries/base/GHC/IO/Unsafe.hs
@@ -0,0 +1,180 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude
+           , MagicHash
+           , UnboxedTuples
+  #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Unsafe
+-- Copyright   :  (c) The University of Glasgow 1994-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Unsafe IO operations
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Unsafe (
+    unsafePerformIO, unsafeInterleaveIO,
+    unsafeDupablePerformIO, unsafeDupableInterleaveIO,
+    noDuplicate,
+  ) where
+
+import GHC.Base
+
+
+{-|
+This is the \"back door\" into the 'IO' monad, allowing
+'IO' computation to be performed at any time.  For
+this to be safe, the 'IO' computation should be
+free of side effects and independent of its environment.
+
+If the I\/O computation wrapped in 'unsafePerformIO' performs side
+effects, then the relative order in which those side effects take
+place (relative to the main I\/O trunk, or other calls to
+'unsafePerformIO') is indeterminate.  Furthermore, when using
+'unsafePerformIO' to cause side-effects, you should take the following
+precautions to ensure the side effects are performed as many times as
+you expect them to be.  Note that these precautions are necessary for
+GHC, but may not be sufficient, and other compilers may require
+different precautions:
+
+  * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@
+        that calls 'unsafePerformIO'.  If the call is inlined,
+        the I\/O may be performed more than once.
+
+  * Use the compiler flag @-fno-cse@ to prevent common sub-expression
+        elimination being performed on the module, which might combine
+        two side effects that were meant to be separate.  A good example
+        is using multiple global variables (like @test@ in the example below).
+
+  * Make sure that the either you switch off let-floating (@-fno-full-laziness@), or that the
+        call to 'unsafePerformIO' cannot float outside a lambda.  For example,
+        if you say:
+        @
+           f x = unsafePerformIO (newIORef [])
+        @
+        you may get only one reference cell shared between all calls to @f@.
+        Better would be
+        @
+           f x = unsafePerformIO (newIORef [x])
+        @
+        because now it can't float outside the lambda.
+
+It is less well known that
+'unsafePerformIO' is not type safe.  For example:
+
+>     test :: IORef [a]
+>     test = unsafePerformIO $ newIORef []
+>
+>     main = do
+>             writeIORef test [42]
+>             bang <- readIORef test
+>             print (bang :: [Char])
+
+This program will core dump.  This problem with polymorphic references
+is well known in the ML community, and does not arise with normal
+monadic use of references.  There is no easy way to make it impossible
+once you use 'unsafePerformIO'.  Indeed, it is
+possible to write @coerce :: a -> b@ with the
+help of 'unsafePerformIO'.  So be careful!
+-}
+unsafePerformIO :: IO a -> a
+unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)
+
+{-|
+This version of 'unsafePerformIO' is more efficient
+because it omits the check that the IO is only being performed by a
+single thread.  Hence, when you use 'unsafeDupablePerformIO',
+there is a possibility that the IO action may be performed multiple
+times (on a multiprocessor), and you should therefore ensure that
+it gives the same results each time. It may even happen that one
+of the duplicated IO actions is only run partially, and then interrupted
+in the middle without an exception being raised. Therefore, functions
+like 'bracket' cannot be used safely within 'unsafeDupablePerformIO'.
+
+@since 4.4.0.0
+-}
+unsafeDupablePerformIO  :: IO a -> a
+unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> a
+
+-- Note [unsafeDupablePerformIO is NOINLINE]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Why do we NOINLINE unsafeDupablePerformIO?  See the comment with
+-- GHC.ST.runST.  Essentially the issue is that the IO computation
+-- inside unsafePerformIO must be atomic: it must either all run, or
+-- not at all.  If we let the compiler see the application of the IO
+-- to realWorld#, it might float out part of the IO.
+
+-- Note [unsafeDupablePerformIO has a lazy RHS]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Why is there a call to 'lazy' in unsafeDupablePerformIO?
+-- If we don't have it, the demand analyser discovers the following strictness
+-- for unsafeDupablePerformIO:  C(U(AV))
+-- But then consider
+--      unsafeDupablePerformIO (\s -> let r = f x in
+--                             case writeIORef v r s of (# s1, _ #) ->
+--                             (# s1, r #) )
+-- The strictness analyser will find that the binding for r is strict,
+-- (because of uPIO's strictness sig), and so it'll evaluate it before
+-- doing the writeIORef.  This actually makes libraries/base/tests/memo002
+-- get a deadlock, where we specifically wanted to write a lazy thunk
+-- into the ref cell.
+--
+-- Solution: don't expose the strictness of unsafeDupablePerformIO,
+--           by hiding it with 'lazy'
+-- But see discussion in Trac #9390 (comment:33)
+
+{-|
+'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
+When passed a value of type @IO a@, the 'IO' will only be performed
+when the value of the @a@ is demanded.  This is used to implement lazy
+file reading, see 'System.IO.hGetContents'.
+-}
+{-# INLINE unsafeInterleaveIO #-}
+unsafeInterleaveIO :: IO a -> IO a
+unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
+
+-- We used to believe that INLINE on unsafeInterleaveIO was safe,
+-- because the state from this IO thread is passed explicitly to the
+-- interleaved IO, so it cannot be floated out and shared.
+--
+-- HOWEVER, if the compiler figures out that r is used strictly here,
+-- then it will eliminate the thunk and the side effects in m will no
+-- longer be shared in the way the programmer was probably expecting,
+-- but can be performed many times.  In #5943, this broke our
+-- definition of fixIO, which contains
+--
+--    ans <- unsafeInterleaveIO (takeMVar m)
+--
+-- after inlining, we lose the sharing of the takeMVar, so the second
+-- time 'ans' was demanded we got a deadlock.  We could fix this with
+-- a readMVar, but it seems wrong for unsafeInterleaveIO to sometimes
+-- share and sometimes not (plus it probably breaks the noDuplicate).
+-- So now, we do not inline unsafeDupableInterleaveIO.
+
+{-# NOINLINE unsafeDupableInterleaveIO #-}
+unsafeDupableInterleaveIO :: IO a -> IO a
+unsafeDupableInterleaveIO (IO m)
+  = IO ( \ s -> let
+                   r = case m s of (# _, res #) -> res
+                in
+                (# s, r #))
+
+{-|
+Ensures that the suspensions under evaluation by the current thread
+are unique; that is, the current thread is not evaluating anything
+that is also under evaluation by another thread that has also executed
+'noDuplicate'.
+
+This operation is used in the definition of 'unsafePerformIO' to
+prevent the IO action from being executed multiple times, which is usually
+undesirable.
+-}
+noDuplicate :: IO ()
+noDuplicate = IO $ \s -> case noDuplicate# s of s' -> (# s', () #)
diff --git a/libraries/base/GHC/Stack.hs b/libraries/base/GHC/Stack.hs
new file mode 100644
index 0000000000..d1dd596ca6
--- /dev/null
+++ b/libraries/base/GHC/Stack.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Stack
+-- Copyright   :  (c) The University of Glasgow 2011
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Access to GHC's call-stack simulation
+--
+-- @since 4.5.0.0
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-}
+module GHC.Stack (
+    -- * Call stacks
+    currentCallStack,
+    whoCreated,
+    errorWithStackTrace,
+
+    -- * Implicit parameter call stacks
+    SrcLoc(..), CallStack(..),
+
+    -- * Internals
+    CostCentreStack,
+    CostCentre,
+    getCurrentCCS,
+    getCCSOf,
+    ccsCC,
+    ccsParent,
+    ccLabel,
+    ccModule,
+    ccSrcSpan,
+    ccsToStrings,
+    renderStack
+  ) where
+
+import GHC.Stack.CCS
+import GHC.IO
+import GHC.Base
+import GHC.List
+import GHC.Exception
+
+-- | Like the function 'error', but appends a stack trace to the error
+-- message if one is available.
+--
+-- @since 4.7.0.0
+{-# DEPRECATED errorWithStackTrace "'error' appends the call stack now" #-}
+  -- DEPRECATED in 8.0.1
+errorWithStackTrace :: String -> a
+errorWithStackTrace x = unsafeDupablePerformIO $ do
+   stack <- ccsToStrings =<< getCurrentCCS x
+   if null stack
+      then throwIO (ErrorCall x)
+      else throwIO (ErrorCallWithLocation x (renderStack stack))
diff --git a/libraries/base/GHC/Stack.hsc b/libraries/base/GHC/Stack.hsc
index 6ef1fa5d25..c544721e63 100644
--- a/libraries/base/GHC/Stack.hsc
+++ b/libraries/base/GHC/Stack.hsc
@@ -47,7 +47,6 @@ import GHC.Base
 import GHC.Ptr
 import GHC.Foreign as GHC
 import GHC.IO.Encoding
-import GHC.Exception
 import GHC.List ( concatMap, null, reverse )
 
 #define PROFILING
diff --git a/libraries/base/GHC/Stack/CCS.hs-boot b/libraries/base/GHC/Stack/CCS.hs-boot
new file mode 100644
index 0000000000..1ac7876921
--- /dev/null
+++ b/libraries/base/GHC/Stack/CCS.hs-boot
@@ -0,0 +1,16 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module GHC.Stack.CCS where
+
+{- Cuts the following loop:
+
+   GHC.Exception.errorCallWithCallStackException requires
+   GHC.Stack.CCS.currentCallStack, which requires
+   Foreign.C (for peeking CostCentres)
+   GHC.Foreign, GHC.IO.Encoding (for decoding UTF-8 strings)
+   .. lots of stuff ...
+   GHC.Exception
+-}
+
+import GHC.Base
+
+currentCallStack :: IO [String]
diff --git a/libraries/base/GHC/Stack/CCS.hsc b/libraries/base/GHC/Stack/CCS.hsc
new file mode 100644
index 0000000000..6d62a1e235
--- /dev/null
+++ b/libraries/base/GHC/Stack/CCS.hsc
@@ -0,0 +1,116 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Stack.CCS
+-- Copyright   :  (c) The University of Glasgow 2011
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Access to GHC's call-stack simulation
+--
+-- @since 4.5.0.0
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-}
+module GHC.Stack.CCS (
+    -- * Call stacks
+    currentCallStack,
+    whoCreated,
+
+    -- * Internals
+    CostCentreStack,
+    CostCentre,
+    getCurrentCCS,
+    getCCSOf,
+    ccsCC,
+    ccsParent,
+    ccLabel,
+    ccModule,
+    ccSrcSpan,
+    ccsToStrings,
+    renderStack
+  ) where
+
+import Foreign
+import Foreign.C
+
+import GHC.Base
+import GHC.Ptr
+import GHC.Foreign as GHC
+import GHC.IO.Encoding
+import GHC.List ( concatMap, reverse )
+
+#define PROFILING
+#include "Rts.h"
+
+data CostCentreStack
+data CostCentre
+
+getCurrentCCS :: dummy -> IO (Ptr CostCentreStack)
+getCurrentCCS dummy = IO $ \s ->
+   case getCurrentCCS## dummy s of
+     (## s', addr ##) -> (## s', Ptr addr ##)
+
+getCCSOf :: a -> IO (Ptr CostCentreStack)
+getCCSOf obj = IO $ \s ->
+   case getCCSOf## obj s of
+     (## s', addr ##) -> (## s', Ptr addr ##)
+
+ccsCC :: Ptr CostCentreStack -> IO (Ptr CostCentre)
+ccsCC p = (# peek CostCentreStack, cc) p
+
+ccsParent :: Ptr CostCentreStack -> IO (Ptr CostCentreStack)
+ccsParent p = (# peek CostCentreStack, prevStack) p
+
+ccLabel :: Ptr CostCentre -> IO CString
+ccLabel p = (# peek CostCentre, label) p
+
+ccModule :: Ptr CostCentre -> IO CString
+ccModule p = (# peek CostCentre, module) p
+
+ccSrcSpan :: Ptr CostCentre -> IO CString
+ccSrcSpan p = (# peek CostCentre, srcloc) p
+
+-- | returns a '[String]' representing the current call stack.  This
+-- can be useful for debugging.
+--
+-- The implementation uses the call-stack simulation maintined by the
+-- profiler, so it only works if the program was compiled with @-prof@
+-- and contains suitable SCC annotations (e.g. by using @-fprof-auto@).
+-- Otherwise, the list returned is likely to be empty or
+-- uninformative.
+--
+-- @since 4.5.0.0
+
+currentCallStack :: IO [String]
+currentCallStack = ccsToStrings =<< getCurrentCCS ()
+
+ccsToStrings :: Ptr CostCentreStack -> IO [String]
+ccsToStrings ccs0 = go ccs0 []
+  where
+    go ccs acc
+     | ccs == nullPtr = return acc
+     | otherwise = do
+        cc  <- ccsCC ccs
+        lbl <- GHC.peekCString utf8 =<< ccLabel cc
+        mdl <- GHC.peekCString utf8 =<< ccModule cc
+        loc <- GHC.peekCString utf8 =<< ccSrcSpan cc
+        parent <- ccsParent ccs
+        if (mdl == "MAIN" && lbl == "MAIN")
+           then return acc
+           else go parent ((mdl ++ '.':lbl ++ ' ':'(':loc ++ ")") : acc)
+
+-- | Get the stack trace attached to an object.
+--
+-- @since 4.5.0.0
+whoCreated :: a -> IO [String]
+whoCreated obj = do
+  ccs <- getCCSOf obj
+  ccsToStrings ccs
+
+renderStack :: [String] -> String
+renderStack strs = "Stack trace:" ++ concatMap ("\n  "++) (reverse strs)
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index e94d38949a..7c89be4cfa 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -238,6 +238,7 @@ Library
         GHC.IO.Handle.Text
         GHC.IO.Handle.Types
         GHC.IO.IOMode
+        GHC.IO.Unsafe
         GHC.IOArray
         GHC.IORef
         GHC.Int
@@ -259,6 +260,7 @@ Library
         GHC.Show
         GHC.Stable
         GHC.Stack
+        GHC.Stack.CCS
         GHC.Stack.Types
         GHC.Stats
         GHC.Storable
diff --git a/libraries/base/tests/assert.stderr b/libraries/base/tests/assert.stderr
index 7183f1e763..2f809bd466 100644
--- a/libraries/base/tests/assert.stderr
+++ b/libraries/base/tests/assert.stderr
@@ -1,4 +1,3 @@
 assert: Assertion failed
-CallStack:
+CallStack (from ImplicitParams):
   assert, called at assert.hs:9:11 in main:Main
-
diff --git a/libraries/base/tests/readFloat.stderr b/libraries/base/tests/readFloat.stderr
index 99049a35b7..a3a84648f0 100644
--- a/libraries/base/tests/readFloat.stderr
+++ b/libraries/base/tests/readFloat.stderr
@@ -1,3 +1,3 @@
 readFloat: Prelude.read: no parse
-CallStack:
+CallStack (from ImplicitParams):
   error, called at libraries/base/Text/Read.hs:90:17 in base:Text.Read
diff --git a/libraries/hpc b/libraries/hpc
-Subproject e20c61c358e749ea62f6687089ad2a878d5d1a6
+Subproject 5123582f48b46efc3d27424bc475125a1de78e2
diff --git a/libraries/stm b/libraries/stm
-Subproject e917b5944ce0a5b4e32dcc8f00eaddbec1256e9
+Subproject 9870cf156e5e7e21785b236da41f2466bf9f4b2
diff --git a/testsuite/tests/annotations/should_fail/annfail12.stderr b/testsuite/tests/annotations/should_fail/annfail12.stderr
index 37e8378a7e..303645914e 100644
--- a/testsuite/tests/annotations/should_fail/annfail12.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail12.stderr
@@ -2,7 +2,7 @@
 annfail12.hs:5:1: error:
     Exception when trying to run compile-time code:
       You were meant to see this error!
-CallStack:
+CallStack (from ImplicitParams):
   error, called at annfail12.hs:5:12 in main:Annfail12
     In the annotation:
       {-# ANN f (error "You were meant to see this error!" :: Int) #-}
diff --git a/testsuite/tests/array/should_run/arr003.stderr b/testsuite/tests/array/should_run/arr003.stderr
index bffb356a6d..a0d56ed0a6 100644
--- a/testsuite/tests/array/should_run/arr003.stderr
+++ b/testsuite/tests/array/should_run/arr003.stderr
@@ -1,3 +1,3 @@
 arr003: Ix{Int}.index: Index (4) out of range ((1,3))
-CallStack:
+CallStack (from ImplicitParams):
   error, called at libraries/base/GHC/Arr.hs:176:5 in base:GHC.Arr
diff --git a/testsuite/tests/array/should_run/arr004.stderr b/testsuite/tests/array/should_run/arr004.stderr
index b053770e1a..e109855a71 100644
--- a/testsuite/tests/array/should_run/arr004.stderr
+++ b/testsuite/tests/array/should_run/arr004.stderr
@@ -1,3 +1,3 @@
 arr004: (Array.!): undefined array element
-CallStack:
+CallStack (from ImplicitParams):
   error, called at libraries/base/GHC/Arr.hs:402:16 in base:GHC.Arr
diff --git a/testsuite/tests/array/should_run/arr007.stderr b/testsuite/tests/array/should_run/arr007.stderr
index f23cb319d9..4c02cecf6e 100644
--- a/testsuite/tests/array/should_run/arr007.stderr
+++ b/testsuite/tests/array/should_run/arr007.stderr
@@ -1,3 +1,3 @@
 arr007: Ix{Int}.index: Index (1) out of range ((1,0))
-CallStack:
+CallStack (from ImplicitParams):
   error, called at libraries/base/GHC/Arr.hs:176:5 in base:GHC.Arr
diff --git a/testsuite/tests/array/should_run/arr008.stderr b/testsuite/tests/array/should_run/arr008.stderr
index b3cf392eb3..5355a07162 100644
--- a/testsuite/tests/array/should_run/arr008.stderr
+++ b/testsuite/tests/array/should_run/arr008.stderr
@@ -1,3 +1,3 @@
 arr008: Ix{Int}.index: Index (2) out of range ((0,1))
-CallStack:
+CallStack (from ImplicitParams):
   error, called at libraries/base/GHC/Arr.hs:176:5 in base:GHC.Arr
diff --git a/testsuite/tests/codeGen/should_run/T5626.stderr b/testsuite/tests/codeGen/should_run/T5626.stderr
index a97f66c30e..2c02bb0a5c 100644
--- a/testsuite/tests/codeGen/should_run/T5626.stderr
+++ b/testsuite/tests/codeGen/should_run/T5626.stderr
@@ -1,4 +1,4 @@
 T5626: Prelude.undefined
-CallStack:
-  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+CallStack (from ImplicitParams):
+  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
   undefined, called at T5626.hs:6:30 in main:Main
diff --git a/testsuite/tests/codeGen/should_run/cgrun016.stderr b/testsuite/tests/codeGen/should_run/cgrun016.stderr
index dba44be468..33cd2bdbdf 100644
--- a/testsuite/tests/codeGen/should_run/cgrun016.stderr
+++ b/testsuite/tests/codeGen/should_run/cgrun016.stderr
@@ -1,3 +1,3 @@
 cgrun016: 6th call to error
-CallStack:
+CallStack (from ImplicitParams):
   error, called at cgrun016.hs:8:8 in main:Main
diff --git a/testsuite/tests/codeGen/should_run/cgrun045.stderr b/testsuite/tests/codeGen/should_run/cgrun045.stderr
index 4c7719b1c8..d7f8188c8b 100644
--- a/testsuite/tests/codeGen/should_run/cgrun045.stderr
+++ b/testsuite/tests/codeGen/should_run/cgrun045.stderr
@@ -1,3 +1,3 @@
 cgrun045: hello world!
-CallStack:
+CallStack (from ImplicitParams):
   error, called at cgrun045.hs:6:13 in main:Main
diff --git a/testsuite/tests/codeGen/should_run/cgrun051.stderr b/testsuite/tests/codeGen/should_run/cgrun051.stderr
index 0a96a43628..432dd5649b 100644
--- a/testsuite/tests/codeGen/should_run/cgrun051.stderr
+++ b/testsuite/tests/codeGen/should_run/cgrun051.stderr
@@ -1,3 +1,3 @@
 cgrun051: OK
-CallStack:
+CallStack (from ImplicitParams):
   error, called at cgrun051.hs:7:25 in main:Main
diff --git a/testsuite/tests/codeGen/should_run/cgrun059.stderr b/testsuite/tests/codeGen/should_run/cgrun059.stderr
index 15000537aa..2365a03ee5 100644
--- a/testsuite/tests/codeGen/should_run/cgrun059.stderr
+++ b/testsuite/tests/codeGen/should_run/cgrun059.stderr
@@ -1,3 +1,3 @@
 cgrun059: Error: File not found
-CallStack:
+CallStack (from ImplicitParams):
   error, called at cgrun059.hs:12:28 in main:Main
diff --git a/testsuite/tests/concurrent/should_run/conc021.stderr b/testsuite/tests/concurrent/should_run/conc021.stderr
index c7348b77bd..b48a068ba7 100644
--- a/testsuite/tests/concurrent/should_run/conc021.stderr
+++ b/testsuite/tests/concurrent/should_run/conc021.stderr
@@ -1,3 +1,3 @@
 conc021: wurble
-CallStack:
+CallStack (from ImplicitParams):
   error, called at conc021.hs:9:9 in main:Main
diff --git a/testsuite/tests/deriving/should_run/T5628.stderr b/testsuite/tests/deriving/should_run/T5628.stderr
index edc44bd3b1..e203374673 100644
--- a/testsuite/tests/deriving/should_run/T5628.stderr
+++ b/testsuite/tests/deriving/should_run/T5628.stderr
@@ -1,3 +1,3 @@
 T5628: Void ==
-CallStack:
+CallStack (from ImplicitParams):
   error, called at T5628.hs:5:1 in main:Main
diff --git a/testsuite/tests/driver/sigof02/sigof02.stderr b/testsuite/tests/driver/sigof02/sigof02.stderr
index 1dc1beb935..0fb77f6f9b 100644
--- a/testsuite/tests/driver/sigof02/sigof02.stderr
+++ b/testsuite/tests/driver/sigof02/sigof02.stderr
@@ -1,4 +1,4 @@
 StrictMain: Prelude.undefined
-CallStack:
-  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+CallStack (from ImplicitParams):
+  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
   undefined, called at Main.hs:6:22 in main:Main
diff --git a/testsuite/tests/driver/sigof02/sigof02m.stderr b/testsuite/tests/driver/sigof02/sigof02m.stderr
index 1dc1beb935..0fb77f6f9b 100644
--- a/testsuite/tests/driver/sigof02/sigof02m.stderr
+++ b/testsuite/tests/driver/sigof02/sigof02m.stderr
@@ -1,4 +1,4 @@
 StrictMain: Prelude.undefined
-CallStack:
-  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+CallStack (from ImplicitParams):
+  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
   undefined, called at Main.hs:6:22 in main:Main
diff --git a/testsuite/tests/ffi/should_run/ffi008.stderr b/testsuite/tests/ffi/should_run/ffi008.stderr
index 78605178a6..83999ed16e 100644
--- a/testsuite/tests/ffi/should_run/ffi008.stderr
+++ b/testsuite/tests/ffi/should_run/ffi008.stderr
@@ -1,3 +1,3 @@
 ffi008: this is an error
-CallStack:
+CallStack (from ImplicitParams):
   error, called at ffi008.hs:12:12 in main:Main
diff --git a/testsuite/tests/ffi/should_run/fptrfail01.stderr b/testsuite/tests/ffi/should_run/fptrfail01.stderr
index 5193181ea9..cf29208275 100644
--- a/testsuite/tests/ffi/should_run/fptrfail01.stderr
+++ b/testsuite/tests/ffi/should_run/fptrfail01.stderr
@@ -1,3 +1,3 @@
 fptrfail01: GHC.ForeignPtr: attempt to mix Haskell and C finalizers in the same ForeignPtr
-CallStack:
-  error, called at libraries/base/GHC/ForeignPtr.hs:352:17 in base:GHC.ForeignPtr
+CallStack (from ImplicitParams):
+  error, called at libraries/base/GHC/ForeignPtr.hs:361:17 in base:GHC.ForeignPtr
diff --git a/testsuite/tests/ghc-e/should_run/ghc-e005.stderr b/testsuite/tests/ghc-e/should_run/ghc-e005.stderr
index 5836586c79..31194ee1a6 100644
--- a/testsuite/tests/ghc-e/should_run/ghc-e005.stderr
+++ b/testsuite/tests/ghc-e/should_run/ghc-e005.stderr
@@ -1,3 +1,3 @@
 ghc-e005-prog: foo
-CallStack:
+CallStack (from ImplicitParams):
   error, called at ghc-e005.hs:12:10 in main:Main
diff --git a/testsuite/tests/ghci.debugger/scripts/break009.stdout b/testsuite/tests/ghci.debugger/scripts/break009.stdout
index 14543668a1..9a4fa56446 100644
--- a/testsuite/tests/ghci.debugger/scripts/break009.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break009.stdout
@@ -2,5 +2,5 @@ Breakpoint 0 activated at ../Test6.hs:5:8-11
 Stopped at ../Test6.hs:5:8-11
 _result :: a2 = _
 *** Exception: Prelude.head: empty list
-CallStack:
+CallStack (from ImplicitParams):
   error, called at libraries/base/GHC/List.hs:999:3 in base:GHC.List
diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout
index 67bbec7ce1..69cbcc4373 100644
--- a/testsuite/tests/ghci.debugger/scripts/break011.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout
@@ -1,5 +1,5 @@
 *** Exception: foo
-CallStack:
+CallStack (from ImplicitParams):
   error, called at <interactive>:2:1 in interactive:Ghci1
 Stopped at <exception thrown>
 _exception :: e = _
@@ -21,17 +21,17 @@ already at the beginning of the history
 _exception = SomeException
                (ErrorCallWithLocation
                   "foo"
-                  "CallStack:
+                  "CallStack (from ImplicitParams):
   error, called at ../Test7.hs:2:18 in main:Main")
 _result :: a14 = _
 _exception :: SomeException = SomeException
                                 (ErrorCallWithLocation
                                    "foo"
-                                   "CallStack:
+                                   "CallStack (from ImplicitParams):
   error, called at ../Test7.hs:2:18 in main:Main")
 *** Exception: foo
-CallStack:
+CallStack (from ImplicitParams):
   error, called at ../Test7.hs:2:18 in main:Main
 *** Exception: foo
-CallStack:
+CallStack (from ImplicitParams):
   error, called at ../Test7.hs:2:18 in main:Main
diff --git a/testsuite/tests/ghci.debugger/scripts/break017.stdout b/testsuite/tests/ghci.debugger/scripts/break017.stdout
index 4825e435bb..2bc2c23837 100644
--- a/testsuite/tests/ghci.debugger/scripts/break017.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break017.stdout
@@ -8,7 +8,7 @@ Printing 1
 as = 'b' : 'c' : (_t1::[Char])
 Forcing
 *** Exception: Prelude.undefined
-CallStack:
+CallStack (from ImplicitParams):
   error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
   undefined, called at <interactive>:3:17 in interactive:Ghci1
 Printing 2
diff --git a/testsuite/tests/ghci/scripts/T10501.stderr b/testsuite/tests/ghci/scripts/T10501.stderr
index b9e45ccc66..7fffbe8231 100644
--- a/testsuite/tests/ghci/scripts/T10501.stderr
+++ b/testsuite/tests/ghci/scripts/T10501.stderr
@@ -1,7 +1,7 @@
 *** Exception: Prelude.head: empty list
-CallStack:
-  error, called at libraries/base/GHC/List.hs:1009:3 in base:GHC.List
+CallStack (from ImplicitParams):
+  error, called at libraries/base/GHC/List.hs:999:3 in base:GHC.List
 *** Exception: Prelude.undefined
-CallStack:
-  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+CallStack (from ImplicitParams):
+  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
   undefined, called at <interactive>:1:17 in interactive:Ghci1
diff --git a/testsuite/tests/ghci/scripts/T5557.stdout b/testsuite/tests/ghci/scripts/T5557.stdout
index aa3a83242e..86df6ab67c 100644
--- a/testsuite/tests/ghci/scripts/T5557.stdout
+++ b/testsuite/tests/ghci/scripts/T5557.stdout
@@ -1,8 +1,8 @@
 *** Exception: Prelude.undefined
-CallStack:
+CallStack (from ImplicitParams):
   error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
   undefined, called at <interactive>:2:12 in interactive:Ghci1
 *** Exception: Prelude.undefined
-CallStack:
+CallStack (from ImplicitParams):
   error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
   undefined, called at <interactive>:3:12 in interactive:Ghci1
diff --git a/testsuite/tests/ghci/scripts/ghci055.stdout b/testsuite/tests/ghci/scripts/ghci055.stdout
index 03245e2097..d57430bb8c 100644
--- a/testsuite/tests/ghci/scripts/ghci055.stdout
+++ b/testsuite/tests/ghci/scripts/ghci055.stdout
@@ -1,5 +1,5 @@
 *** Exception: Prelude.undefined
-CallStack:
+CallStack (from ImplicitParams):
   error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
   undefined, called at <interactive>:1:7 in interactive:Ghci1
 x :: t = _
diff --git a/testsuite/tests/profiling/should_run/ioprof.stderr b/testsuite/tests/profiling/should_run/ioprof.stderr
index 3910245347..db9c36bbe3 100644
--- a/testsuite/tests/profiling/should_run/ioprof.stderr
+++ b/testsuite/tests/profiling/should_run/ioprof.stderr
@@ -1,3 +1,14 @@
 ioprof: a
-CallStack:
+CallStack (from ImplicitParams):
   error, called at ioprof.hs:23:22 in main:Main
+CallStack (from -prof):
+  Main.errorM.\ (ioprof.hs:23:22-28)
+  Main.errorM (ioprof.hs:23:1-28)
+  Main.foo (ioprof.hs:34:1-16)
+  Main.>>=.\ (ioprof.hs:(11,27)-(12,50))
+  Main.>>= (ioprof.hs:(11,3)-(12,50))
+  Main.<*> (ioprof.hs:20:5-14)
+  Main.bar (ioprof.hs:31:1-20)
+  Main.runM (ioprof.hs:26:1-37)
+  Main.main (ioprof.hs:28:1-43)
+  Main.CAF (<entire-module>)
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr
index f752129770..974af21631 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr
@@ -1,3 +1,3 @@
 SafeLang09: This curry is poisoned!
-CallStack:
+CallStack (from ImplicitParams):
   error, called at ./SafeLang09_B.hs:14:13 in main:SafeLang09_B
diff --git a/testsuite/tests/simplCore/should_fail/T7411.stderr b/testsuite/tests/simplCore/should_fail/T7411.stderr
index 59c0617e9b..6fc6a22560 100644
--- a/testsuite/tests/simplCore/should_fail/T7411.stderr
+++ b/testsuite/tests/simplCore/should_fail/T7411.stderr
@@ -1,4 +1,4 @@
 T7411: Prelude.undefined
-CallStack:
-  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+CallStack (from ImplicitParams):
+  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
   undefined, called at T7411.hs:3:25 in main:Main
diff --git a/testsuite/tests/simplCore/should_run/T457.stderr b/testsuite/tests/simplCore/should_run/T457.stderr
index 983c8dba39..c84855e500 100644
--- a/testsuite/tests/simplCore/should_run/T457.stderr
+++ b/testsuite/tests/simplCore/should_run/T457.stderr
@@ -1,3 +1,3 @@
 T457: Correct
-CallStack:
+CallStack (from ImplicitParams):
   error, called at T457.hs:5:22 in main:Main
diff --git a/testsuite/tests/simplCore/should_run/T5587.stderr b/testsuite/tests/simplCore/should_run/T5587.stderr
index d98a36d986..069d08d055 100644
--- a/testsuite/tests/simplCore/should_run/T5587.stderr
+++ b/testsuite/tests/simplCore/should_run/T5587.stderr
@@ -1,3 +1,3 @@
 T5587: hidden error
-CallStack:
+CallStack (from ImplicitParams):
   error, called at T5587.hs:7:15 in main:Main
diff --git a/testsuite/tests/simplCore/should_run/T5625.stderr b/testsuite/tests/simplCore/should_run/T5625.stderr
index f272d99787..fe02e7e6a8 100644
--- a/testsuite/tests/simplCore/should_run/T5625.stderr
+++ b/testsuite/tests/simplCore/should_run/T5625.stderr
@@ -1,4 +1,4 @@
 T5625: Prelude.undefined
-CallStack:
-  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+CallStack (from ImplicitParams):
+  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
   undefined, called at T5625.hs:3:31 in main:Main
diff --git a/testsuite/tests/stranal/should_run/strun002.stderr b/testsuite/tests/stranal/should_run/strun002.stderr
index 2e2f85b780..735b981a88 100644
--- a/testsuite/tests/stranal/should_run/strun002.stderr
+++ b/testsuite/tests/stranal/should_run/strun002.stderr
@@ -1,3 +1,3 @@
 strun002: Variable not found: (2) hello
-CallStack:
+CallStack (from ImplicitParams):
   error, called at strun002.hs:7:11 in main:Main
diff --git a/testsuite/tests/th/T5358.stderr b/testsuite/tests/th/T5358.stderr
index 695c69e3d9..4a17272310 100644
--- a/testsuite/tests/th/T5358.stderr
+++ b/testsuite/tests/th/T5358.stderr
@@ -2,7 +2,7 @@
 T5358.hs:14:12: error:
     Exception when trying to run compile-time code:
       runTest called error: forall (t_0 :: *) . t_0 -> GHC.Types.Bool
-CallStack:
+CallStack (from ImplicitParams):
   error, called at T5358.hs:15:18 in main:T5358
     Code: do { VarI _ t _ <- reify (mkName "prop_x1");
                ($) error ((++) "runTest called error: " pprint t) }
diff --git a/testsuite/tests/th/T5976.stderr b/testsuite/tests/th/T5976.stderr
index f434458a01..507d9d8b8d 100644
--- a/testsuite/tests/th/T5976.stderr
+++ b/testsuite/tests/th/T5976.stderr
@@ -2,6 +2,6 @@
 T5976.hs:1:1: error:
     Exception when trying to run compile-time code:
       bar
-CallStack:
+CallStack (from ImplicitParams):
   error, called at T5976.hs:3:21 in main:Main
     Code: error ((++) "foo " error "bar")
diff --git a/testsuite/tests/th/T8987.stderr b/testsuite/tests/th/T8987.stderr
index 6df4f7d4ec..1af2e29b7f 100644
--- a/testsuite/tests/th/T8987.stderr
+++ b/testsuite/tests/th/T8987.stderr
@@ -2,7 +2,7 @@
 T8987.hs:1:1: error:
     Exception when trying to run compile-time code:
       Prelude.undefined
-CallStack:
-  error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err
+CallStack (from ImplicitParams):
+  error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err
   undefined, called at T8987.hs:6:23 in main:T8987
     Code: (>>) reportWarning ['1', undefined] return []
diff --git a/testsuite/tests/th/TH_exn2.stderr b/testsuite/tests/th/TH_exn2.stderr
index fb914289a3..b4d5b8df84 100644
--- a/testsuite/tests/th/TH_exn2.stderr
+++ b/testsuite/tests/th/TH_exn2.stderr
@@ -2,7 +2,7 @@
 TH_exn2.hs:1:1: error:
     Exception when trying to run compile-time code:
       Prelude.tail: empty list
-CallStack:
-  error, called at libraries/base/GHC/List.hs:1009:3 in base:GHC.List
+CallStack (from ImplicitParams):
+  error, called at libraries/base/GHC/List.hs:999:3 in base:GHC.List
     Code: do { ds <- [d| |];
                return (tail ds) }
diff --git a/testsuite/tests/typecheck/should_run/IPLocation.stdout b/testsuite/tests/typecheck/should_run/IPLocation.stdout
index 47de194981..d02250f8de 100644
--- a/testsuite/tests/typecheck/should_run/IPLocation.stdout
+++ b/testsuite/tests/typecheck/should_run/IPLocation.stdout
@@ -1,24 +1,24 @@
-CallStack:
+CallStack (from ImplicitParams):
   ?loc, called at IPLocation.hs:8:31 in main:Main
-CallStack:
+CallStack (from ImplicitParams):
   ?loc, called at IPLocation.hs:12:31 in main:Main
   f1, called at IPLocation.hs:40:11 in main:Main
-CallStack:
+CallStack (from ImplicitParams):
   ?loc, called at IPLocation.hs:16:34 in main:Main
   f2, called at IPLocation.hs:41:11 in main:Main
-CallStack:
+CallStack (from ImplicitParams):
   ?loc, called at IPLocation.hs:17:34 in main:Main
   f2, called at IPLocation.hs:41:11 in main:Main
-CallStack:
+CallStack (from ImplicitParams):
   ?loc, called at IPLocation.hs:42:48 in main:Main
   x, called at IPLocation.hs:22:8 in main:Main
-CallStack:
+CallStack (from ImplicitParams):
   ?loc, called at IPLocation.hs:43:48 in main:Main
   x, called at IPLocation.hs:27:8 in main:Main
   f4, called at IPLocation.hs:43:11 in main:Main
-CallStack:
+CallStack (from ImplicitParams):
   ?loc3, called at IPLocation.hs:44:48 in main:Main
-CallStack:
+CallStack (from ImplicitParams):
   ?loc, called at IPLocation.hs:35:33 in main:Main
   f6, called at IPLocation.hs:36:8 in main:Main
   f6, called at IPLocation.hs:36:8 in main:Main