Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/e1d28c19f7a6b3a9f0e3584f0315b4b2c5235de6 >--------------------------------------------------------------- commit e1d28c19f7a6b3a9f0e3584f0315b4b2c5235de6 Author: Simon Marlow <[email protected]> Date: Thu Aug 9 09:10:32 2012 +0100 add errorWithStackTrace -- | Like the function 'error', but appends a stack trace to the error -- message if one is available. errorWithStackTrace :: String -> a >--------------------------------------------------------------- GHC/Stack.hsc | 11 +++++++++++ 1 files changed, 11 insertions(+), 0 deletions(-) diff --git a/GHC/Stack.hsc b/GHC/Stack.hsc index 80e4c9f..849a48c 100644 --- a/GHC/Stack.hsc +++ b/GHC/Stack.hsc @@ -17,6 +17,7 @@ module GHC.Stack ( -- * Call stack currentCallStack, whoCreated, + errorWithStackTrace, -- * Internals CostCentreStack, @@ -40,6 +41,7 @@ import GHC.Base import GHC.Ptr import GHC.Foreign as GHC import GHC.IO.Encoding +import GHC.Exception #define PROFILING #include "Rts.h" @@ -106,3 +108,12 @@ whoCreated obj = do renderStack :: [String] -> String renderStack strs = "Stack trace:" ++ concatMap ("\n "++) (reverse strs) + +-- | Like the function 'error', but appends a stack trace to the error +-- message if one is available. +errorWithStackTrace :: String -> a +errorWithStackTrace x = unsafeDupablePerformIO $ do + stack <- ccsToStrings =<< getCurrentCCS x + if null stack + then throwIO (ErrorCall x) + else throwIO (ErrorCall (x ++ '\n' : renderStack stack)) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
