diff options
Diffstat (limited to 'libraries/base/GHC/Stack.hs')
| -rw-r--r-- | libraries/base/GHC/Stack.hs | 30 |
1 files changed, 28 insertions, 2 deletions
diff --git a/libraries/base/GHC/Stack.hs b/libraries/base/GHC/Stack.hs index d7c5c94193..727910a659 100644 --- a/libraries/base/GHC/Stack.hs +++ b/libraries/base/GHC/Stack.hs @@ -15,7 +15,7 @@ -- @since 4.5.0.0 ----------------------------------------------------------------------------- -{-# LANGUAGE MagicHash, NoImplicitPrelude #-} +{-# LANGUAGE MagicHash, NoImplicitPrelude, ImplicitParams, RankNTypes #-} module GHC.Stack ( -- * Call stacks currentCallStack, @@ -23,7 +23,8 @@ module GHC.Stack ( errorWithStackTrace, -- * Implicit parameter call stacks - CallStack, getCallStack, pushCallStack, prettyCallStack, + CallStack, emptyCallStack, freezeCallStack, getCallStack, popCallStack, + prettyCallStack, pushCallStack, withFrozenCallStack, -- * Source locations SrcLoc(..), prettySrcLoc, @@ -62,3 +63,28 @@ errorWithStackTrace x = unsafeDupablePerformIO $ do 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 + + +-- | Perform some computation without adding new entries to the 'CallStack'. +-- +-- @since 4.9.0.0 +withFrozenCallStack :: (?callStack :: CallStack) + => ( (?callStack :: CallStack) => 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 |