{-# 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 ----------------------------------------------------------------------------- module GHC.Stack ( errorWithStackTrace, -- * Profiling call stacks currentCallStack, whoCreated, -- * HasCallStack call stacks CallStack, HasCallStack, callStack, emptyCallStack, freezeCallStack, fromCallSiteList, getCallStack, popCallStack, prettyCallStack, pushCallStack, withFrozenCallStack, -- * Source locations SrcLoc(..), prettySrcLoc, -- * Internals CostCentreStack, CostCentre, getCurrentCCS, getCCSOf, clearCCS, ccsCC, ccsParent, ccLabel, ccModule, ccSrcSpan, ccsToStrings, renderStack ) where import GHC.Stack.CCS import GHC.Stack.Types 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)) -- | 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 popCallStack :: CallStack -> CallStack popCallStack stk = case stk of EmptyCallStack -> errorWithoutStackTrace "popCallStack: empty stack" PushCallStack _ _ stk' -> stk' FreezeCallStack _ -> stk {-# INLINE popCallStack #-} -- | Return the current 'CallStack'. -- -- Does *not* include the call-site of 'callStack'. -- -- @since 4.9.0.0 callStack :: HasCallStack => CallStack callStack = case ?callStack of EmptyCallStack -> EmptyCallStack _ -> popCallStack ?callStack {-# INLINE callStack #-} -- | Perform some computation without adding new entries to the 'CallStack'. -- -- @since 4.9.0.0 withFrozenCallStack :: HasCallStack => ( HasCallStack => a ) -> a withFrozenCallStack do_this = -- we pop the stack before freezing it to remove -- withFrozenCallStack's call-site let ?callStack = freezeCallStack (popCallStack callStack) in do_this