(original) (raw)

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

{-# OPTIONS_HADDOCK not-home #-}

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.Num.Integer ()

type HasCallStack = (?callStack :: CallStack)

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

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

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

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

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

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

data SrcLoc = SrcLoc { SrcLoc -> [Char] srcLocPackage :: [Char] , SrcLoc -> [Char] srcLocModule :: [Char] , SrcLoc -> [Char] srcLocFile :: [Char] , SrcLoc -> Int srcLocStartLine :: Int , SrcLoc -> Int srcLocStartCol :: Int , SrcLoc -> Int srcLocEndLine :: Int , SrcLoc -> Int srcLocEndCol :: Int } deriving SrcLoc -> SrcLoc -> Bool (SrcLoc -> SrcLoc -> Bool) -> (SrcLoc -> SrcLoc -> Bool) -> Eq SrcLoc forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: SrcLoc -> SrcLoc -> Bool == :: SrcLoc -> SrcLoc -> Bool $c/= :: SrcLoc -> SrcLoc -> Bool /= :: SrcLoc -> SrcLoc -> Bool Eq