    {-# LANGUAGE ImplicitParams #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE Trustworthy #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.Internal.Stack
    -- Copyright   :  (c) The University of Glasgow 2011
    -- License     :  see libraries/base/LICENSE
    --
    -- Maintainer  :  ghc-devs@haskell.org
    -- Stability   :  internal
    -- Portability :  non-portable (GHC Extensions)
    --
    -- Access to GHC's call-stack simulation
    --
    -- @since base-4.5.0.0
    -----------------------------------------------------------------------------

    module GHC.Internal.Stack (
        errorWithStackTrace,

        -- * Profiling call stacks
        currentCallStack,
        whoCreated,

        -- * HasCallStack call stacks
        CallStack, HasCallStack, callStack, emptyCallStack, freezeCallStack,
        fromCallSiteList, getCallStack, popCallStack,
        pushCallStack, withFrozenCallStack,
        prettyCallStackLines, prettyCallStack,

        -- * Source locations
        SrcLoc(..), prettySrcLoc,

        -- * Internals
        CostCentreStack,
        CostCentre,
        getCurrentCCS,
        getCCSOf,
        clearCCS,
        ccsCC,
        ccsParent,
        ccLabel,
        ccModule,
        ccSrcSpan,
        ccsToStrings,
        renderStack
      ) where

    import GHC.Internal.Show
    import GHC.Internal.Stack.CCS
    import GHC.Internal.Stack.Types
    import GHC.Internal.Base
    import GHC.Internal.Data.OldList (intercalate)
    import GHC.Internal.Exception
    import GHC.Internal.IO (unsafeDupablePerformIO, throwIO)

    -- | Like the function 'error', but appends a stack trace to the error
    -- message if one is available.
    --
    -- @since base-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
    $ ErrorCall -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> ErrorCall
    ErrorCall String
    x)

    -- | Pop the most recent call-site off the 'CallStack'.
    --
    -- This function, like 'pushCallStack', has no effect on a frozen 'CallStack'.
    --
    -- @since base-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 base-4.9.0.0
    callStack :: HasCallStack => CallStack
    callStack :: HasCallStack => CallStack
    callStack =
      case CallStack
    forall (x :: Symbol) a. IP x a => a
    ?callStack of
        CallStack
    EmptyCallStack -> CallStack
    EmptyCallStack
        CallStack
    _              -> CallStack -> CallStack
    popCallStack CallStack
    forall (x :: Symbol) a. IP x a => a
    ?callStack
    {-# INLINE callStack #-}

    -- | Perform some computation without adding new entries to the 'CallStack'.
    --
    -- @since base-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

    -- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot
    -- files. See Note [Definition of CallStack]

    -- | Pretty print a 'SrcLoc'.
    --
    -- @since 4.9.0.0
    prettySrcLoc :: SrcLoc -> String
    prettySrcLoc :: SrcLoc -> String
    prettySrcLoc SrcLoc {Int
    String
    srcLocPackage :: String
    srcLocModule :: String
    srcLocFile :: String
    srcLocStartLine :: Int
    srcLocStartCol :: Int
    srcLocEndLine :: Int
    srcLocEndCol :: Int
    srcLocEndCol :: SrcLoc -> Int
    srcLocEndLine :: SrcLoc -> Int
    srcLocStartCol :: SrcLoc -> Int
    srcLocStartLine :: SrcLoc -> Int
    srcLocFile :: SrcLoc -> String
    srcLocModule :: SrcLoc -> String
    srcLocPackage :: SrcLoc -> String
    ..}
      = (String -> String -> String) -> String -> [String] -> String
    forall a b. (a -> b -> b) -> b -> [a] -> b
    foldr String -> String -> String
    forall a. [a] -> [a] -> [a]
    (++) String
    ""
          [ String
    srcLocFile, String
    ":"
          , Int -> String
    forall a. Show a => a -> String
    show Int
    srcLocStartLine, String
    ":"
          , Int -> String
    forall a. Show a => a -> String
    show Int
    srcLocStartCol, String
    " in "
          , String
    srcLocPackage, String
    ":", String
    srcLocModule
          ]

    -- | Pretty print a 'CallStack'.
    --
    -- @since 4.9.0.0
    prettyCallStack :: CallStack -> String
    prettyCallStack :: CallStack -> String
    prettyCallStack = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" ([String] -> String)
    -> (CallStack -> [String]) -> CallStack -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CallStack -> [String]
    prettyCallStackLines

    prettyCallStackLines :: CallStack -> [String]
    prettyCallStackLines :: CallStack -> [String]
    prettyCallStackLines CallStack
    cs = case CallStack -> [(String, SrcLoc)]
    getCallStack CallStack
    cs of
      []  -> []
      [(String, SrcLoc)]
    stk -> String
    "CallStack (from HasCallStack):"
           String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : ((String, SrcLoc) -> String) -> [(String, SrcLoc)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String
    "  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String)
    -> ((String, SrcLoc) -> String) -> (String, SrcLoc) -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, SrcLoc) -> String
    prettyCallSite) [(String, SrcLoc)]
    stk
      where
        prettyCallSite :: (String, SrcLoc) -> String
    prettyCallSite (String
    f, SrcLoc
    loc) = String
    f String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", called at " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SrcLoc -> String
    prettySrcLoc SrcLoc
    loc