    {-# 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 :: 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
          then ErrorCall -> IO a
    forall e a. Exception e => e -> IO a
    throwIO (String -> ErrorCall
    ErrorCall String
    x)
          else ErrorCall -> 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.0
    popCallStack :: CallStack -> CallStack
    popCallStack :: CallStack -> CallStack
    popCallStack CallStack
    stk = case CallStack
    stk of
      CallStack
    EmptyCallStack         -> String -> CallStack
    forall a. String -> a
    errorWithoutStackTrace String
    "popCallStack: empty stack"
      PushCallStack String
    _ SrcLoc
    _ CallStack
    stk' -> CallStack
    stk'
      FreezeCallStack CallStack
    _      -> CallStack
    stk
    {-# INLINE popCallStack #-}

    -- | Return the current 'CallStack'.
    --
    -- Does *not* include the call-site of 'callStack'.
    --
    -- @since 4.9.0.0
    callStack :: HasCallStack => CallStack
    callStack :: HasCallStack => CallStack
    callStack =
      case HasCallStack
    CallStack
    ?callStack of
        CallStack
    EmptyCallStack -> CallStack
    EmptyCallStack
        CallStack
    _              -> CallStack -> CallStack
    popCallStack HasCallStack
    CallStack
    ?callStack
    {-# INLINE callStack #-}

    -- | Perform some computation without adding new entries to the 'CallStack'.
    --
    -- @since 4.9.0.0
    withFrozenCallStack :: 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-site
      let ?callStack = CallStack -> CallStack
    freezeCallStack (CallStack -> CallStack
    popCallStack CallStack
    HasCallStack => CallStack
    callStack)
      in a
    HasCallStack => a
    do_this