Copyright | (c) The University of Glasgow 2011 |
---|---|
License | see libraries/base/LICENSE |
Maintainer | cvs-ghc@haskell.org |
Stability | internal |
Portability | non-portable (GHC Extensions) |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
Access to GHC's call-stack simulation
Since: 4.5.0.0
Synopsis
- errorWithStackTrace :: String -> a
- currentCallStack :: IO [String]
- whoCreated :: a -> IO [String]
- data CallStack
- type HasCallStack = ?callStack :: CallStack
- callStack :: HasCallStack => CallStack
- emptyCallStack :: CallStack
- freezeCallStack :: CallStack -> CallStack
- fromCallSiteList :: [([Char], SrcLoc)] -> CallStack
- getCallStack :: CallStack -> [([Char], SrcLoc)]
- popCallStack :: CallStack -> CallStack
- prettyCallStack :: CallStack -> String
- pushCallStack :: ([Char], SrcLoc) -> CallStack -> CallStack
- withFrozenCallStack :: HasCallStack => (HasCallStack => a) -> a
- data SrcLoc = SrcLoc {
- srcLocPackage :: [Char]
- srcLocModule :: [Char]
- srcLocFile :: [Char]
- srcLocStartLine :: Int
- srcLocStartCol :: Int
- srcLocEndLine :: Int
- srcLocEndCol :: Int
- prettySrcLoc :: SrcLoc -> String
- data CostCentreStack
- data CostCentre
- getCurrentCCS :: dummy -> IO (Ptr CostCentreStack)
- getCCSOf :: a -> IO (Ptr CostCentreStack)
- clearCCS :: IO a -> IO a
- ccsCC :: Ptr CostCentreStack -> IO (Ptr CostCentre)
- ccsParent :: Ptr CostCentreStack -> IO (Ptr CostCentreStack)
- ccLabel :: Ptr CostCentre -> IO CString
- ccModule :: Ptr CostCentre -> IO CString
- ccSrcSpan :: Ptr CostCentre -> IO CString
- ccsToStrings :: Ptr CostCentreStack -> IO [String]
- renderStack :: [String] -> String
Documentation
errorWithStackTrace :: String -> a Source #
Profiling call stacks
currentCallStack :: IO [String] Source #
Returns a [String]
representing the current call stack. This
can be useful for debugging.
The implementation uses the call-stack simulation maintained 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
whoCreated :: a -> IO [String] Source #
Get the stack trace attached to an object.
Since: 4.5.0.0
HasCallStack call stacks
CallStack
s are a lightweight method of obtaining a
partial call-stack at any point in the program.
A function can request its call-site with the HasCallStack
constraint.
For example, we can define
putStrLnWithCallStack :: HasCallStack => String -> IO ()
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 callStack
.
putStrLnWithCallStack :: HasCallStack => String -> IO () putStrLnWithCallStack msg = do putStrLn msg putStrLn (prettyCallStack callStack)
Thus, if we call putStrLnWithCallStack
we will get a formatted call-stack
alongside our string.
>>>
putStrLnWithCallStack "hello"
hello CallStack (from HasCallStack): putStrLnWithCallStack, called at <interactive>:2:1 in interactive:Ghci1
GHC solves HasCallStack
constraints in three steps:
- If there is a
CallStack
in scope -- i.e. the enclosing function has aHasCallStack
constraint -- GHC will append the new call-site to the existingCallStack
. - If there is no
CallStack
in scope -- e.g. in the GHCi session above -- and the enclosing definition does not have an explicit type signature, GHC will infer aHasCallStack
constraint for the enclosing definition (subject to the monomorphism restriction). - If there is no
CallStack
in scope and the enclosing definition has an explicit type signature, GHC will solve theHasCallStack
constraint for the singletonCallStack
containing just the current call-site.
CallStack
s do not interact with the RTS and do not require compilation
with -prof
. On the other hand, as they are built up explicitly via the
HasCallStack
constraints, they will generally not contain as much
information as the simulated call-stacks maintained by the RTS.
A CallStack
is a [(String, SrcLoc)]
. The String
is the name of
function that was called, the SrcLoc
is the call-site. The list is
ordered with the most recently called function at the head.
NOTE: The intrepid user may notice that HasCallStack
is just an
alias for an implicit parameter ?callStack :: CallStack
. This is an
implementation detail and should not be considered part of the
CallStack
API, we may decide to change the implementation in the
future.
Since: 4.8.1.0
type HasCallStack = ?callStack :: CallStack Source #
Request a CallStack.
NOTE: The implicit parameter ?callStack :: CallStack
is an
implementation detail and should not be considered part of the
CallStack
API, we may decide to change the implementation in the
future.
Since: 4.9.0.0
callStack :: HasCallStack => CallStack Source #
emptyCallStack :: CallStack Source #
The empty CallStack
.
Since: 4.9.0.0
freezeCallStack :: CallStack -> CallStack Source #
Freeze a call-stack, preventing any further call-sites from being appended.
pushCallStack callSite (freezeCallStack callStack) = freezeCallStack callStack
Since: 4.9.0.0
fromCallSiteList :: [([Char], SrcLoc)] -> CallStack Source #
Convert a list of call-sites to a CallStack
.
Since: 4.9.0.0
getCallStack :: CallStack -> [([Char], SrcLoc)] Source #
Extract a list of call-sites from the CallStack
.
The list is ordered by most recent call.
Since: 4.8.1.0
popCallStack :: CallStack -> CallStack Source #
Pop the most recent call-site off the CallStack
.
This function, like pushCallStack
, has no effect on a frozen CallStack
.
Since: 4.9.0.0
withFrozenCallStack :: HasCallStack => (HasCallStack => a) -> a Source #
Perform some computation without adding new entries to the CallStack
.
Since: 4.9.0.0
Source locations
A single location in the source code.
Since: 4.8.1.0
SrcLoc | |
|
Instances
Internals
data CostCentreStack Source #
A cost-centre stack from GHC's cost-center profiler.
data CostCentre Source #
A cost-centre from GHC's cost-center profiler.
getCurrentCCS :: dummy -> IO (Ptr CostCentreStack) Source #
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).
getCCSOf :: a -> IO (Ptr CostCentreStack) Source #
Get the CostCentreStack
associated with the given value.
clearCCS :: IO a -> IO a Source #
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.
ccsCC :: Ptr CostCentreStack -> IO (Ptr CostCentre) Source #
Get the CostCentre
at the head of a CostCentreStack
.
ccsParent :: Ptr CostCentreStack -> IO (Ptr CostCentreStack) Source #
Get the tail of a CostCentreStack
.
ccLabel :: Ptr CostCentre -> IO CString Source #
Get the label of a CostCentre
.
ccModule :: Ptr CostCentre -> IO CString Source #
Get the module of a CostCentre
.
ccSrcSpan :: Ptr CostCentre -> IO CString Source #
Get the source span of a CostCentre
.
ccsToStrings :: Ptr CostCentreStack -> IO [String] Source #
Format a CostCentreStack
as a list of lines.
renderStack :: [String] -> String Source #