(original) (raw)

{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-}

{-# OPTIONS_HADDOCK hide #-}

module GHC.Stack.Types (

[CallStack](GHC.Stack.Types.html#CallStack)(..), [HasCallStack](GHC.Stack.Types.html#HasCallStack),
[emptyCallStack](GHC.Stack.Types.html#emptyCallStack), [freezeCallStack](GHC.Stack.Types.html#freezeCallStack), [fromCallSiteList](GHC.Stack.Types.html#fromCallSiteList),
[getCallStack](GHC.Stack.Types.html#getCallStack), [pushCallStack](GHC.Stack.Types.html#pushCallStack),


[SrcLoc](GHC.Stack.Types.html#SrcLoc)(..)

) where

import GHC.Classes (Eq) import GHC.Types (Char, Int)

import GHC.Tuple () import GHC.Integer () import GHC.Natural ()

type HasCallStack = (?callStack :: CallStack)

data CallStack = EmptyCallStack | PushCallStack [Char] SrcLoc CallStack | FreezeCallStack CallStack

getCallStack :: CallStack -> [([Char], SrcLoc)] getCallStack stk = case stk of EmptyCallStack -> [] PushCallStack fn loc stk' -> (fn,loc) : getCallStack stk' FreezeCallStack stk' -> getCallStack stk'

fromCallSiteList :: [([Char], SrcLoc)] -> CallStack fromCallSiteList ((fn,loc):cs) = PushCallStack fn loc (fromCallSiteList cs) fromCallSiteList [] = EmptyCallStack

pushCallStack :: ([Char], SrcLoc) -> CallStack -> CallStack pushCallStack (fn, loc) stk = case stk of FreezeCallStack _ -> stk _ -> PushCallStack fn loc stk {-# INLINE pushCallStack #-}

emptyCallStack :: CallStack emptyCallStack = EmptyCallStack {-# INLINE emptyCallStack #-}

freezeCallStack :: CallStack -> CallStack freezeCallStack stk = FreezeCallStack stk {-# INLINE freezeCallStack #-}

data SrcLoc = SrcLoc { srcLocPackage :: [Char] , srcLocModule :: [Char] , srcLocFile :: [Char] , srcLocStartLine :: Int , srcLocStartCol :: Int , srcLocEndLine :: Int , srcLocEndCol :: Int } deriving Eq