[commit: ghc] master: base: Delete errant GHC/Stack.hsc (7e6dcf4)
git at git.haskell.org
git at git.haskell.org
Fri Nov 20 15:49:17 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/7e6dcf482addcba89f2835e55e41720881cb10a4/ghc
>---------------------------------------------------------------
commit 7e6dcf482addcba89f2835e55e41720881cb10a4
Author: Ben Gamari <ben at smart-cactus.org>
Date: Thu Nov 19 17:58:37 2015 +0100
base: Delete errant GHC/Stack.hsc
This was added in 8988be8561ce0857f3befd6ab3b6c29060685c0a, probably due
to an incorrect merge resolution. The build system has been building
`Stack.hs`.
>---------------------------------------------------------------
7e6dcf482addcba89f2835e55e41720881cb10a4
libraries/base/GHC/Stack.hs | 2 +-
libraries/base/GHC/Stack.hsc | 132 -------------------------------------------
2 files changed, 1 insertion(+), 133 deletions(-)
diff --git a/libraries/base/GHC/Stack.hs b/libraries/base/GHC/Stack.hs
index d1dd596..f6fe41f 100644
--- a/libraries/base/GHC/Stack.hs
+++ b/libraries/base/GHC/Stack.hs
@@ -15,7 +15,7 @@
-- @since 4.5.0.0
-----------------------------------------------------------------------------
-{-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-}
+{-# LANGUAGE MagicHash, NoImplicitPrelude #-}
module GHC.Stack (
-- * Call stacks
currentCallStack,
diff --git a/libraries/base/GHC/Stack.hsc b/libraries/base/GHC/Stack.hsc
deleted file mode 100644
index c544721..0000000
--- a/libraries/base/GHC/Stack.hsc
+++ /dev/null
@@ -1,132 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.Stack
--- Copyright : (c) The University of Glasgow 2011
--- License : see libraries/base/LICENSE
---
--- Maintainer : cvs-ghc at haskell.org
--- Stability : internal
--- Portability : non-portable (GHC Extensions)
---
--- Access to GHC's call-stack simulation
---
--- @since 4.5.0.0
------------------------------------------------------------------------------
-
-{-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-}
-module GHC.Stack (
- -- * Call stacks
- currentCallStack,
- whoCreated,
- errorWithStackTrace,
-
- -- * Implicit parameter call stacks
- SrcLoc(..), CallStack(..),
-
- -- * Internals
- CostCentreStack,
- CostCentre,
- getCurrentCCS,
- getCCSOf,
- ccsCC,
- ccsParent,
- ccLabel,
- ccModule,
- ccSrcSpan,
- ccsToStrings,
- renderStack
- ) where
-
-import Foreign
-import Foreign.C
-
-import GHC.IO
-import GHC.Base
-import GHC.Ptr
-import GHC.Foreign as GHC
-import GHC.IO.Encoding
-import GHC.List ( concatMap, null, reverse )
-
-#define PROFILING
-#include "Rts.h"
-
-data CostCentreStack
-data CostCentre
-
-getCurrentCCS :: dummy -> IO (Ptr CostCentreStack)
-getCurrentCCS dummy = IO $ \s ->
- case getCurrentCCS## dummy s of
- (## s', addr ##) -> (## s', Ptr addr ##)
-
-getCCSOf :: a -> IO (Ptr CostCentreStack)
-getCCSOf obj = IO $ \s ->
- case getCCSOf## obj s of
- (## s', addr ##) -> (## s', Ptr addr ##)
-
-ccsCC :: Ptr CostCentreStack -> IO (Ptr CostCentre)
-ccsCC p = (# peek CostCentreStack, cc) p
-
-ccsParent :: Ptr CostCentreStack -> IO (Ptr CostCentreStack)
-ccsParent p = (# peek CostCentreStack, prevStack) p
-
-ccLabel :: Ptr CostCentre -> IO CString
-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.
---
--- The implementation uses the call-stack simulation maintined by the
--- profiler, so it only works if the program was compiled with @-prof@
--- and contains suitable SCC annotations (e.g. by using @-fprof-auto@).
--- Otherwise, the list returned is likely to be empty or
--- uninformative.
---
--- @since 4.5.0.0
-
-currentCallStack :: IO [String]
-currentCallStack = ccsToStrings =<< getCurrentCCS ()
-
-ccsToStrings :: Ptr CostCentreStack -> IO [String]
-ccsToStrings ccs0 = go ccs0 []
- where
- go ccs acc
- | ccs == nullPtr = return acc
- | otherwise = do
- 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 ++ ' ':'(':loc ++ ")") : acc)
-
--- | Get the stack trace attached to an object.
---
--- @since 4.5.0.0
-whoCreated :: a -> IO [String]
-whoCreated obj = do
- ccs <- getCCSOf obj
- ccsToStrings ccs
-
-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.
---
--- @since 4.7.0.0
-errorWithStackTrace :: String -> a
-errorWithStackTrace x = unsafeDupablePerformIO $ do
- stack <- ccsToStrings =<< getCurrentCCS x
- if null stack
- then throwIO (ErrorCall x)
- else throwIO (ErrorCallWithLocation x (renderStack stack))
More information about the ghc-commits
mailing list