{-# LANGUAGE ImplicitParams #-}{-# LANGUAGE NoImplicitPrelude #-}{-# LANGUAGE RankNTypes #-}{-# 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-----------------------------------------------------------------------------moduleGHC.Stack(errorWithStackTrace ,-- * Profiling call stackscurrentCallStack ,whoCreated ,-- * HasCallStack call stacksCallStack ,HasCallStack ,callStack ,emptyCallStack ,freezeCallStack ,fromCallSiteList ,getCallStack ,popCallStack ,prettyCallStack ,pushCallStack ,withFrozenCallStack ,-- * Source locationsSrcLoc (..),prettySrcLoc ,-- * InternalsCostCentreStack ,CostCentre ,getCurrentCCS ,getCCSOf ,clearCCS ,ccsCC ,ccsParent ,ccLabel ,ccModule ,ccSrcSpan ,ccsToStrings ,renderStack )whereimportGHC.Stack.CCS importGHC.Stack.Types importGHC.IO importGHC.Base importGHC.List importGHC.Exception -- | Like the function 'error', but appends a stack trace to the error-- message if one is available.---- @since 4.7.0.0{-# DEPRECATEDerrorWithStackTrace"'error' appends the call stack now"#-}-- DEPRECATED in 8.0.1errorWithStackTrace ::String ->a errorWithStackTrace :: forall a. String -> a
errorWithStackTrace String
x =IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do[String]
stack <-Ptr CostCentreStack -> IO [String]
ccsToStrings (Ptr CostCentreStack -> IO [String])
-> IO (Ptr CostCentreStack) -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Ptr CostCentreStack)
forall dummy. dummy -> IO (Ptr CostCentreStack)
getCurrentCCS String
x if[String] -> Bool
forall a. [a] -> Bool
null [String]
stack thenErrorCall -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> ErrorCall
ErrorCall String
x )elseErrorCall -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> String -> ErrorCall
ErrorCallWithLocation String
x ([String] -> String
renderStack [String]
stack ))-- | Pop the most recent call-site off the 'CallStack'.---- This function, like 'pushCallStack', has no effect on a frozen 'CallStack'.---- @since 4.9.0.0popCallStack ::CallStack ->CallStack popCallStack :: CallStack -> CallStack
popCallStack CallStack
stk =caseCallStack
stk ofCallStack
EmptyCallStack ->String -> CallStack
forall a. String -> a
errorWithoutStackTrace String
"popCallStack: empty stack"PushCallStack String
_SrcLoc
_CallStack
stk' ->CallStack
stk' FreezeCallStack CallStack
_->CallStack
stk {-# INLINEpopCallStack #-}-- | Return the current 'CallStack'.---- Does *not* include the call-site of 'callStack'.---- @since 4.9.0.0callStack ::HasCallStack =>CallStack callStack :: HasCallStack => CallStack
callStack =caseHasCallStack
CallStack
?callStack ofCallStack
EmptyCallStack ->CallStack
EmptyCallStack CallStack
_->CallStack -> CallStack
popCallStack HasCallStack
CallStack
?callStack {-# INLINEcallStack #-}-- | Perform some computation without adding new entries to the 'CallStack'.---- @since 4.9.0.0withFrozenCallStack ::HasCallStack =>(HasCallStack =>a )->a withFrozenCallStack :: forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => a
do_this =-- we pop the stack before freezing it to remove-- withFrozenCallStack's call-sitelet?callStack=CallStack -> CallStack
freezeCallStack (CallStack -> CallStack
popCallStack CallStack
HasCallStack => CallStack
callStack )ina
HasCallStack => a
do_this