Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/71f44c44af9074c76910939c2cd0cdc3b8c3c5e9 >--------------------------------------------------------------- commit 71f44c44af9074c76910939c2cd0cdc3b8c3c5e9 Author: Duncan Coutts <[email protected]> Date: Mon Oct 15 02:20:17 2012 +0100 Add Debug.Trace.traceMarker/traceMarkerIO Much like the traceEvent, but used for marking points in time during execution for use in profiling tools. This uses the traceMarker# primop. The underlying RTS code currently works for the eventlog system, but could be extended to cover heap profiling. >--------------------------------------------------------------- Debug/Trace.hs | 85 +++++++++++++++++++++++++++++++++++++++++++++++-------- 1 files changed, 72 insertions(+), 13 deletions(-) diff --git a/Debug/Trace.hs b/Debug/Trace.hs index 4400c6c..998b4a4 100644 --- a/Debug/Trace.hs +++ b/Debug/Trace.hs @@ -31,6 +31,11 @@ module Debug.Trace ( -- $eventlog_tracing traceEvent, traceEventIO, + + -- * Execution phase markers + -- $markers + traceMarker, + traceMarkerIO, ) where import Prelude @@ -119,6 +124,22 @@ variables @x@ and @z@: traceShow :: (Show a) => a -> b -> b traceShow = trace . show +-- | like 'trace', but additionally prints a call stack if one is +-- available. +-- +-- In the current GHC implementation, the call stack is only +-- availble if the program was compiled with @-prof@; otherwise +-- 'traceStack' behaves exactly like 'trace'. Entries in the call +-- stack correspond to @SCC@ annotations, so it is a good idea to use +-- @-fprof-auto@ or @-fprof-auto-calls@ to add SCC annotations automatically. +-- +traceStack :: String -> a -> a +traceStack str expr = unsafePerformIO $ do + traceIO str + stack <- currentCallStack + when (not (null stack)) $ traceIO (renderStack stack) + return expr + -- $eventlog_tracing -- @@ -164,18 +185,56 @@ traceEventIO msg = traceEventIO msg = (return $! length msg) >> return () #endif --- | like 'trace', but additionally prints a call stack if one is --- available. + +-- $markers -- --- In the current GHC implementation, the call stack is only --- availble if the program was compiled with @-prof@; otherwise --- 'traceStack' behaves exactly like 'trace'. Entries in the call --- stack correspond to @SCC@ annotations, so it is a good idea to use --- @-fprof-auto@ or @-fprof-auto-calls@ to add SCC annotations automatically. +-- When looking at a profile for the execution of a program we often want to +-- be able to mark certain points or phases in the execution and see that +-- visually in the profile. + +-- For example, a program might have several distinct phases with different +-- performance or resource behaviour in each phase. To properly interpret the +-- profile graph we really want to see when each phase starts and ends. -- -traceStack :: String -> a -> a -traceStack str expr = unsafePerformIO $ do - traceIO str - stack <- currentCallStack - when (not (null stack)) $ traceIO (renderStack stack) - return expr +-- Markers let us do this: we can annotate the program to emit a marker at +-- an appropriate point during execution and then see that in a profile. +-- +-- Currently this feature is only supported in GHC by the eventlog tracing +-- system, but in future it may also be supported by the heap profiling or +-- other profiling tools. These function exists for other Haskell +-- implementations but they have no effect. Note that the string message is +-- always evaluated, whether or not profiling is available or enabled. + +{-# NOINLINE traceMarker #-} +-- | The 'traceMarker' function emits a marker to the eventlog, if eventlog +-- profiling is available and enabled at runtime. The @String@ is the name of +-- the marker. The name is just used in the profiling tools to help you keep +-- clear which marker is which. +-- +-- This function is suitable for use in pure code. In an IO context use +-- 'traceMarkerIO' instead. +-- +-- Note that when using GHC's SMP runtime, it is possible (but rare) to get +-- duplicate events emitted if two CPUs simultaneously evaluate the same thunk +-- that uses 'traceMarker'. +-- +traceMarker :: String -> a -> a +traceMarker msg expr = unsafeDupablePerformIO $ do + traceMarkerIO msg + return expr + +-- | The 'traceMarkerIO' function emits a marker to the eventlog, if eventlog +-- profiling is available and enabled at runtime. +-- +-- Compared to 'traceMarker', 'traceMarkerIO' sequences the event with respect to +-- other IO actions. +-- +traceMarkerIO :: String -> IO () +#ifdef __GLASGOW_HASKELL__ +traceMarkerIO msg = + GHC.Foreign.withCString utf8 msg $ \(Ptr p) -> IO $ \s -> + case traceMarker# p s of s' -> (# s', () #) +#else +traceMarkerIO msg = (return $! length msg) >> return () +#endif + _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
