1{-# LANGUAGE NoImplicitPrelude #-} 2{-# LANGUAGE ConstraintKinds #-} 3{-# LANGUAGE ImplicitParams #-} 4{-# LANGUAGE KindSignatures #-} 5{-# LANGUAGE PolyKinds #-} 6{-# LANGUAGE RankNTypes #-} 7{-# LANGUAGE Trustworthy #-} 8 9{-# OPTIONS_HADDOCK not-home #-} 10-- we hide this module from haddock to enforce GHC.Stack as the main 11-- access point. 12 13----------------------------------------------------------------------------- 14-- | 15-- Module : GHC.Stack.Types 16-- Copyright : (c) The University of Glasgow 2015 17-- License : see libraries/ghc-prim/LICENSE 18-- 19-- Maintainer : cvs-ghc@haskell.org 20-- Stability : internal 21-- Portability : non-portable (GHC Extensions) 22-- 23-- type definitions for implicit call-stacks. 24-- Use "GHC.Stack" from the base package instead of importing this 25-- module directly. 26-- 27----------------------------------------------------------------------------- 28 29module GHC.Stack.Types ( 30 -- * Implicit call stacks 31 CallStack(..), HasCallStack, 32 emptyCallStack, freezeCallStack, fromCallSiteList, 33 getCallStack, pushCallStack, 34 35 -- * Source locations 36 SrcLoc(..) 37 ) where 38 39{- 40Ideally these would live in GHC.Stack but sadly they can't due to this 41import cycle, 42 43 Module imports form a cycle: 44 module ‘GHC.Base’ (libraries/base/GHC/Base.hs) 45 imports ‘GHC.Err’ (libraries/base/GHC/Err.hs) 46 which imports ‘GHC.Stack’ (libraries/base/dist-install/build/GHC/Stack.hs) 47 which imports ‘GHC.Base‘ (libraries/base/GHC/Base.hs) 48-} 49 50import GHC.Classes (Eq) 51import GHC.Types (Char, Int) 52 53-- Make implicit dependency known to build system 54import GHC.Tuple () -- See Note [Depend on GHC.Tuple] in GHC.Base 55import GHC.Integer () -- See Note [Depend on GHC.Integer] in GHC.Base 56import GHC.Natural () -- See Note [Depend on GHC.Natural] in GHC.Base 57 58---------------------------------------------------------------------- 59-- Explicit call-stacks built via ImplicitParams 60---------------------------------------------------------------------- 61 62-- | Request a CallStack. 63-- 64-- NOTE: The implicit parameter @?callStack :: CallStack@ is an 65-- implementation detail and __should not__ be considered part of the 66-- 'CallStack' API, we may decide to change the implementation in the 67-- future. 68-- 69-- @since 4.9.0.0 70type HasCallStack = (?callStack :: CallStack) 71 72-- | 'CallStack's are a lightweight method of obtaining a 73-- partial call-stack at any point in the program. 74-- 75-- A function can request its call-site with the 'HasCallStack' constraint. 76-- For example, we can define 77-- 78-- @ 79-- putStrLnWithCallStack :: HasCallStack => String -> IO () 80-- @ 81-- 82-- as a variant of @putStrLn@ that will get its call-site and print it, 83-- along with the string given as argument. We can access the 84-- call-stack inside @putStrLnWithCallStack@ with 'GHC.Stack.callStack'. 85-- 86-- @ 87-- putStrLnWithCallStack :: HasCallStack => String -> IO () 88-- putStrLnWithCallStack msg = do 89-- putStrLn msg 90-- putStrLn (prettyCallStack callStack) 91-- @ 92-- 93-- Thus, if we call @putStrLnWithCallStack@ we will get a formatted call-stack 94-- alongside our string. 95-- 96-- 97-- >>> putStrLnWithCallStack "hello" 98-- hello 99-- CallStack (from HasCallStack): 100-- putStrLnWithCallStack, called at <interactive>:2:1 in interactive:Ghci1 101-- 102-- 103-- GHC solves 'HasCallStack' constraints in three steps: 104-- 105-- 1. If there is a 'CallStack' in scope -- i.e. the enclosing function 106-- has a 'HasCallStack' constraint -- GHC will append the new 107-- call-site to the existing 'CallStack'. 108-- 109-- 2. If there is no 'CallStack' in scope -- e.g. in the GHCi session 110-- above -- and the enclosing definition does not have an explicit 111-- type signature, GHC will infer a 'HasCallStack' constraint for the 112-- enclosing definition (subject to the monomorphism restriction). 113-- 114-- 3. If there is no 'CallStack' in scope and the enclosing definition 115-- has an explicit type signature, GHC will solve the 'HasCallStack' 116-- constraint for the singleton 'CallStack' containing just the 117-- current call-site. 118-- 119-- 'CallStack's do not interact with the RTS and do not require compilation 120-- with @-prof@. On the other hand, as they are built up explicitly via the 121-- 'HasCallStack' constraints, they will generally not contain as much 122-- information as the simulated call-stacks maintained by the RTS. 123-- 124-- A 'CallStack' is a @[(String, SrcLoc)]@. The @String@ is the name of 125-- function that was called, the 'SrcLoc' is the call-site. The list is 126-- ordered with the most recently called function at the head. 127-- 128-- NOTE: The intrepid user may notice that 'HasCallStack' is just an 129-- alias for an implicit parameter @?callStack :: CallStack@. This is an 130-- implementation detail and __should not__ be considered part of the 131-- 'CallStack' API, we may decide to change the implementation in the 132-- future. 133-- 134-- @since 4.8.1.0 135data CallStack 136 = EmptyCallStack 137 | PushCallStack [Char] SrcLoc CallStack 138 | FreezeCallStack CallStack 139 -- ^ Freeze the stack at the given @CallStack@, preventing any further 140 -- call-sites from being pushed onto it. 141 142 -- See Note [Overview of implicit CallStacks] 143 144-- | Extract a list of call-sites from the 'CallStack'. 145-- 146-- The list is ordered by most recent call. 147-- 148-- @since 4.8.1.0 149getCallStack :: CallStack -> [([Char], SrcLoc)] 150getCallStack stk = case stk of 151 EmptyCallStack -> [] 152 PushCallStack fn loc stk' -> (fn,loc) : getCallStack stk' 153 FreezeCallStack stk' -> getCallStack stk' 154 155-- | Convert a list of call-sites to a 'CallStack'. 156-- 157-- @since 4.9.0.0 158fromCallSiteList :: [([Char], SrcLoc)] -> CallStack 159fromCallSiteList ((fn,loc):cs) = PushCallStack fn loc (fromCallSiteList cs) 160fromCallSiteList [] = EmptyCallStack 161 162-- Note [Definition of CallStack] 163-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 164-- CallStack is defined very early in base because it is 165-- used by error and undefined. At this point in the dependency graph, 166-- we do not have enough functionality to (conveniently) write a nice 167-- pretty-printer for CallStack. The sensible place to define the 168-- pretty-printer would be GHC.Stack, which is the main access point, 169-- but unfortunately GHC.Stack imports GHC.Exception, which *needs* 170-- the pretty-printer. So the CallStack type and functions are split 171-- between three modules: 172-- 173-- 1. GHC.Stack.Types: defines the type and *simple* functions 174-- 2. GHC.Exception: defines the pretty-printer 175-- 3. GHC.Stack: exports everything and acts as the main access point 176 177 178-- | Push a call-site onto the stack. 179-- 180-- This function has no effect on a frozen 'CallStack'. 181-- 182-- @since 4.9.0.0 183pushCallStack :: ([Char], SrcLoc) -> CallStack -> CallStack 184pushCallStack (fn, loc) stk = case stk of 185 FreezeCallStack _ -> stk 186 _ -> PushCallStack fn loc stk 187{-# INLINE pushCallStack #-} 188 189 190-- | The empty 'CallStack'. 191-- 192-- @since 4.9.0.0 193emptyCallStack :: CallStack 194emptyCallStack = EmptyCallStack 195{-# INLINE emptyCallStack #-} 196 197 198-- | Freeze a call-stack, preventing any further call-sites from being appended. 199-- 200-- prop> pushCallStack callSite (freezeCallStack callStack) = freezeCallStack callStack 201-- 202-- @since 4.9.0.0 203freezeCallStack :: CallStack -> CallStack 204freezeCallStack stk = FreezeCallStack stk 205{-# INLINE freezeCallStack #-} 206 207 208-- | A single location in the source code. 209-- 210-- @since 4.8.1.0 211data SrcLoc = SrcLoc 212 { srcLocPackage :: [Char] 213 , srcLocModule :: [Char] 214 , srcLocFile :: [Char] 215 , srcLocStartLine :: Int 216 , srcLocStartCol :: Int 217 , srcLocEndLine :: Int 218 , srcLocEndCol :: Int 219 } deriving Eq -- ^ @since 4.9.0.0 220