# Changeset View

Changeset View

# Standalone View

Standalone View

# libraries/base/GHC/Stack.hsc

Show All 12 Lines | |||||

13 | -- Access to GHC's call-stack simulation | 13 | -- Access to GHC's call-stack simulation | ||

14 | -- | 14 | -- | ||

15 | -- @since 4.5.0.0 | 15 | -- @since 4.5.0.0 | ||

16 | ----------------------------------------------------------------------------- | 16 | ----------------------------------------------------------------------------- | ||

17 | 17 | | |||

18 | {-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-} | 18 | {-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-} | ||

19 | module GHC.Stack ( | 19 | module GHC.Stack ( | ||

20 | -- * Call stacks | 20 | -- * Call stacks | ||

21 | -- ** Simulated by the RTS | | |||

22 | currentCallStack, | 21 | currentCallStack, | ||

23 | whoCreated, | 22 | whoCreated, | ||

24 | errorWithStackTrace, | 23 | errorWithStackTrace, | ||

25 | 24 | | |||

26 | -- ** Explicitly created via implicit-parameters | | |||

27 | -- | | |||

28 | -- @since 4.8.2.0 | | |||

29 | CallStack, | | |||

30 | getCallStack, | | |||

31 | showCallStack, | | |||

32 | | ||||

33 | -- * Internals | 25 | -- * Internals | ||

34 | CostCentreStack, | 26 | CostCentreStack, | ||

35 | CostCentre, | 27 | CostCentre, | ||

36 | getCurrentCCS, | 28 | getCurrentCCS, | ||

37 | getCCSOf, | 29 | getCCSOf, | ||

38 | ccsCC, | 30 | ccsCC, | ||

39 | ccsParent, | 31 | ccsParent, | ||

40 | ccLabel, | 32 | ccLabel, | ||

41 | ccModule, | 33 | ccModule, | ||

42 | ccSrcSpan, | 34 | ccSrcSpan, | ||

43 | ccsToStrings, | 35 | ccsToStrings, | ||

44 | renderStack | 36 | renderStack | ||

45 | ) where | 37 | ) where | ||

46 | 38 | | |||

47 | import Data.List ( unlines ) | | |||

48 | | ||||

49 | import Foreign | 39 | import Foreign | ||

50 | import Foreign.C | 40 | import Foreign.C | ||

51 | 41 | | |||

52 | import GHC.IO | 42 | import GHC.IO | ||

53 | import GHC.Base | 43 | import GHC.Base | ||

54 | import GHC.Ptr | 44 | import GHC.Ptr | ||

55 | import GHC.Foreign as GHC | 45 | import GHC.Foreign as GHC | ||

56 | import GHC.IO.Encoding | 46 | import GHC.IO.Encoding | ||

57 | import GHC.Exception | 47 | import GHC.Exception | ||

58 | import GHC.List ( concatMap, null, reverse ) | 48 | import GHC.List ( concatMap, null, reverse ) | ||

59 | import GHC.Show | | |||

60 | import GHC.SrcLoc | | |||

61 | 49 | | |||

62 | #define PROFILING | 50 | #define PROFILING | ||

63 | #include "Rts.h" | 51 | #include "Rts.h" | ||

64 | 52 | | |||

65 | data CostCentreStack | 53 | data CostCentreStack | ||

66 | data CostCentre | 54 | data CostCentre | ||

67 | 55 | | |||

68 | getCurrentCCS :: dummy -> IO (Ptr CostCentreStack) | 56 | getCurrentCCS :: dummy -> IO (Ptr CostCentreStack) | ||

▲ Show 20 Lines • Show All 65 Lines • ▼ Show 20 Line(s) | |||||

134 | -- message if one is available. | 122 | -- message if one is available. | ||

135 | -- | 123 | -- | ||

136 | -- @since 4.7.0.0 | 124 | -- @since 4.7.0.0 | ||

137 | errorWithStackTrace :: String -> a | 125 | errorWithStackTrace :: String -> a | ||

138 | errorWithStackTrace x = unsafeDupablePerformIO $ do | 126 | errorWithStackTrace x = unsafeDupablePerformIO $ do | ||

139 | stack <- ccsToStrings =<< getCurrentCCS x | 127 | stack <- ccsToStrings =<< getCurrentCCS x | ||

140 | if null stack | 128 | if null stack | ||

141 | then throwIO (ErrorCall x) | 129 | then throwIO (ErrorCall x) | ||

142 | else throwIO (ErrorCall (x ++ '\n' : renderStack stack)) | 130 | else throwIO (ErrorCallWithLocation x (renderStack stack)) | ||

143 | | ||||

144 | | ||||

145 | ---------------------------------------------------------------------- | | |||

146 | -- Explicit call-stacks built via ImplicitParams | | |||

147 | ---------------------------------------------------------------------- | | |||

148 | | ||||

149 | -- | @CallStack@s are an alternate method of obtaining the call stack at a given | | |||

150 | -- point in the program. | | |||

151 | -- | | |||

152 | -- When an implicit-parameter of type @CallStack@ occurs in a program, GHC will | | |||

153 | -- solve it with the current location. If another @CallStack@ implicit-parameter | | |||

154 | -- is in-scope (e.g. as a function argument), the new location will be appended | | |||

155 | -- to the one in-scope, creating an explicit call-stack. For example, | | |||

156 | -- | | |||

157 | -- @ | | |||

158 | -- myerror :: (?loc :: CallStack) => String -> a | | |||

159 | -- myerror msg = error (msg ++ "\n" ++ showCallStack ?loc) | | |||

160 | -- @ | | |||

161 | -- ghci> myerror "die" | | |||

162 | -- *** Exception: die | | |||

163 | -- ?loc, called at MyError.hs:7:51 in main:MyError | | |||

164 | -- myerror, called at <interactive>:2:1 in interactive:Ghci1 | | |||

165 | -- | | |||

166 | -- @CallStack@s do not interact with the RTS and do not require compilation with | | |||

167 | -- @-prof@. On the other hand, as they are built up explicitly using | | |||

168 | -- implicit-parameters, they will generally not contain as much information as | | |||

169 | -- the simulated call-stacks maintained by the RTS. | | |||

170 | -- | | |||

171 | -- The @CallStack@ type is abstract, but it can be converted into a | | |||

172 | -- @[(String, SrcLoc)]@ via 'getCallStack'. The @String@ is the name of function | | |||

173 | -- that was called, the 'SrcLoc' is the call-site. The list is ordered with the | | |||

174 | -- most recently called function at the head. | | |||

175 | -- | | |||

176 | -- @since 4.8.2.0 | | |||

177 | data CallStack = CallStack { getCallStack :: [(String, SrcLoc)] } | | |||

178 | -- See Note [Overview of implicit CallStacks] | | |||

179 | deriving (Show, Eq) | | |||

180 | | ||||

181 | -- | Pretty print 'CallStack' | | |||

182 | -- | | |||

183 | -- @since 4.8.2.0 | | |||

184 | showCallStack :: CallStack -> String | | |||

185 | showCallStack (CallStack (root:rest)) | | |||

186 | = unlines (showCallSite root : map (indent . showCallSite) rest) | | |||

187 | where | | |||

188 | indent l = " " ++ l | | |||

189 | showCallSite (f, loc) = f ++ ", called at " ++ showSrcLoc loc | | |||

190 | showCallStack _ = error "CallStack cannot be empty!" | |