Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/41bf1ae71a791e800260f901dcc5b298d9671b2f >--------------------------------------------------------------- commit 41bf1ae71a791e800260f901dcc5b298d9671b2f Author: Simon Marlow <[email protected]> Date: Wed Nov 30 10:37:40 2011 +0000 Add traceStack :: String -> a -> a -- | 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@ to add SCC annotations automatically. >--------------------------------------------------------------- Debug/Trace.hs | 19 +++++++++++++++++++ 1 files changed, 19 insertions(+), 0 deletions(-) diff --git a/Debug/Trace.hs b/Debug/Trace.hs index b843629..706d077 100644 --- a/Debug/Trace.hs +++ b/Debug/Trace.hs @@ -23,6 +23,7 @@ module Debug.Trace ( -- $tracing trace, -- :: String -> a -> a traceShow, + traceStack, traceIO, -- :: String -> IO () putTraceMsg, @@ -34,10 +35,12 @@ module Debug.Trace ( import Prelude import System.IO.Unsafe +import Control.Monad #ifdef __GLASGOW_HASKELL__ import Foreign.C.String import qualified GHC.Exts as GHC +import GHC.Stack #else import System.IO (hPutStrLn,stderr) #endif @@ -155,3 +158,19 @@ traceEventIO = GHC.traceEventIO #else traceEventIO msg = (return $! length msg) >> return () #endif + +-- | 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@ 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
