diff options
author | Ben Gamari <ben@smart-cactus.org> | 2015-11-19 17:58:37 +0100 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2015-11-20 16:49:27 +0100 |
commit | 7e6dcf482addcba89f2835e55e41720881cb10a4 (patch) | |
tree | ba2107b4f383f03e2314aa613b746ebc6b8f667b /libraries | |
parent | 998c371b62d31499c95bb8ea3967c44d2ee23e90 (diff) | |
download | haskell-7e6dcf482addcba89f2835e55e41720881cb10a4.tar.gz |
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`.
Diffstat (limited to 'libraries')
-rw-r--r-- | libraries/base/GHC/Stack.hs | 2 | ||||
-rw-r--r-- | libraries/base/GHC/Stack.hsc | 132 |
2 files changed, 1 insertions, 133 deletions
diff --git a/libraries/base/GHC/Stack.hs b/libraries/base/GHC/Stack.hs index d1dd596ca6..f6fe41f06f 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 c544721e63..0000000000 --- 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@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)) |