[commit: base] master: Add source locations to call stack entries. (87f88de)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/87f88de3289ca755941483586e0044210e9b65c7

>---------------------------------------------------------------

commit 87f88de3289ca755941483586e0044210e9b65c7
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Fri Dec 2 13:09:51 2011 +0000

    Add source locations to call stack entries.

>---------------------------------------------------------------

 GHC/Stack.hsc |    7 ++++++-
 1 files changed, 6 insertions(+), 1 deletions(-)

diff --git a/GHC/Stack.hsc b/GHC/Stack.hsc
index a2144fc..0256c50 100644
--- a/GHC/Stack.hsc
+++ b/GHC/Stack.hsc
@@ -27,6 +27,7 @@ module GHC.Stack (
     ccsParent,
     ccLabel,
     ccModule,
+    ccSrcSpan,
     ccsToStrings,
     renderStack
   ) where
@@ -68,6 +69,9 @@ ccLabel p = (# peek CostCentre, label) p
 ccModule :: Ptr CostCentre -> IO CString
 ccModule p = (# peek CostCentre, module) p
 
+ccSrcSpan :: Ptr CostCentre -> IO CString
+ccSrcSpan p = (# peek CostCentre, srcloc) p
+
 -- | returns a '[String]' representing the current call stack.  This
 -- can be useful for debugging.
 --
@@ -89,10 +93,11 @@ ccsToStrings ccs0 = go ccs0 []
         cc  <- ccsCC ccs
         lbl <- GHC.peekCString utf8 =<< ccLabel cc
         mdl <- GHC.peekCString utf8 =<< ccModule cc
+        loc <- GHC.peekCString utf8 =<< ccSrcSpan cc
         parent <- ccsParent ccs
         if (mdl == "MAIN" && lbl == "MAIN")
            then return acc
-           else go parent ((mdl ++ '.':lbl) : acc)
+           else go parent ((mdl ++ '.':lbl ++ ' ':'(':loc ++ ")") : acc)
 
 whoCreated :: a -> IO [String]
 whoCreated obj = do