[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