Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : ghc-7.4
http://hackage.haskell.org/trac/ghc/changeset/88fdacc91a0309de7ab24d963e558a7d8a1816d7 >--------------------------------------------------------------- commit 88fdacc91a0309de7ab24d963e558a7d8a1816d7 Author: Ian Lynagh <[email protected]> Date: Thu Dec 15 20:11:50 2011 +0000 Remove GHC.Exts.traceEventIO Debug.Trace.traceEventIO should be used instead. >--------------------------------------------------------------- Debug/Trace.hs | 11 ++++++++--- GHC/Exts.hs | 11 ++--------- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/Debug/Trace.hs b/Debug/Trace.hs index f011ff3..721ada1 100644 --- a/Debug/Trace.hs +++ b/Debug/Trace.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE CPP, ForeignFunctionInterface #-} +{-# LANGUAGE CPP, ForeignFunctionInterface, MagicHash, UnboxedTuples #-} ----------------------------------------------------------------------------- -- | @@ -39,7 +39,10 @@ import Control.Monad #ifdef __GLASGOW_HASKELL__ import Foreign.C.String -import qualified GHC.Exts as GHC +import GHC.Base +import qualified GHC.Foreign +import GHC.IO.Encoding +import GHC.Ptr import GHC.Stack #else import System.IO (hPutStrLn,stderr) @@ -154,7 +157,9 @@ traceEvent msg expr = unsafeDupablePerformIO $ do -- traceEventIO :: String -> IO () #ifdef __GLASGOW_HASKELL__ -traceEventIO = GHC.traceEventIO +traceEventIO msg = + GHC.Foreign.withCString utf8 msg $ \(Ptr p) -> IO $ \s -> + case traceEvent# p s of s' -> (# s', () #) #else traceEventIO msg = (return $! length msg) >> return () #endif diff --git a/GHC/Exts.hs b/GHC/Exts.hs index 85e17b7..972d8be 100644 --- a/GHC/Exts.hs +++ b/GHC/Exts.hs @@ -47,7 +47,6 @@ module GHC.Exts Down(..), groupWith, sortWith, the, -- * Event logging - traceEventIO, traceEvent, -- * SpecConstr annotations @@ -66,12 +65,11 @@ import GHC.Magic import GHC.Word import GHC.Int import GHC.Ptr -import GHC.Foreign -import GHC.IO.Encoding import GHC.Stack import Data.String import Data.List import Data.Data +import qualified Debug.Trace -- XXX This should really be in Data.Tuple, where the definitions are maxTupleSize :: Int @@ -118,13 +116,8 @@ groupByFB c n eq xs0 = groupByFBCore xs0 -- ----------------------------------------------------------------------------- -- tracing -traceEventIO :: String -> IO () -traceEventIO msg = do - withCString utf8 msg $ \(Ptr p) -> IO $ \s -> - case traceEvent# p s of s' -> (# s', () #) - traceEvent :: String -> IO () -traceEvent = traceEventIO +traceEvent = Debug.Trace.traceEventIO {-# DEPRECATED traceEvent "Use Debug.Trace.traceEvent or Debug.Trace.traceEventIO" #-} _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
