diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Revision history for ghc-trace-events +## v0.1.0 - 2019-11-20 + +* Add traceBinaryEvent and traceBinaryEventIO +* Switch to cabal-version: 2.2 +* Rename Debug.Trace.Internal to Debug.Trace.Flags +* Test with GHC 8.8.1 and 8.6.5 +* Update docs + ## v0.0.0.1 - 2018-08-07 * Test with GHC 8.4.3 and HEAD diff --git a/benchmarks/bench-trace.hs b/benchmarks/bench-trace.hs --- a/benchmarks/bench-trace.hs +++ b/benchmarks/bench-trace.hs @@ -1,16 +1,20 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} import Criterion.Main import qualified Debug.Trace as Base import qualified Debug.Trace.ByteString as B +import qualified Debug.Trace.Flags as F import qualified Debug.Trace.String as S import qualified Debug.Trace.Text as T -import qualified Debug.Trace.Internal as I +#if MIN_VERSION_base(4, 13, 0) +import qualified Debug.Trace.Binary as Bin +#endif main :: IO () main = do - putStrLn $ "userTracingEnabled: " ++ show I.userTracingEnabled + putStrLn $ "userTracingEnabled: " ++ show F.userTracingEnabled defaultMain [ bgroup "traceEvent" [ bench "Base" $ whnf (Base.traceEvent "Hello") () @@ -40,4 +44,8 @@ , bench "ByteString/Unsafe" $ nfIO $ B.unsafeTraceMarkerIO "Hello" , bench "Text" $ nfIO $ T.traceMarkerIO "Hello" ] +#if MIN_VERSION_base(4, 13, 0) + , bench "traceBinaryEvent" $ whnf (Bin.traceBinaryEvent "Hello") () + , bench "traceBinaryEventIO" $ nfIO $ Bin.traceBinaryEventIO "Hello" +#endif ] diff --git a/ghc-trace-events.cabal b/ghc-trace-events.cabal --- a/ghc-trace-events.cabal +++ b/ghc-trace-events.cabal @@ -1,68 +1,89 @@ +cabal-version: 2.2 name: ghc-trace-events -version: 0.0.0.1 -synopsis: Faster replacements for traceEvent and traceMarker -description: This library provies 3 modules: +version: 0.1.0 +synopsis: Faster traceEvent and traceMarker, and binary object logging for + eventlog +description: ghc-trace-events provides faster traceEvent and traceMarker as well + as arbitrary binary object logging for the eventlog framework. Unlike the + , + all the tracing functions in this library don't evaluate the input if user + event logging (the + + flag) is disabled, which can give a significant boost in performance. Take a + look at the benchmark suite for the details. . + This library provies the following modules: + . ["Debug.Trace.String"] Drop-in replacements for the event tracing functions in "Debug.Trace". - ["Debug.Trace.ByteString"] 'Data.ByteString.ByteString' variants of the event - tracing functions in "Debug.Trace". + ["Debug.Trace.ByteString"] UTF-8 encoded 'Data.ByteString.ByteString' variants + of the event tracing functions. It's faster than the String variants. ["Debug.Trace.Text"] 'Data.Text.Text' variants of the event tracing functions - in "Debug.Trace". - . - Unlike the tracing functions in base, all the tracing functions in this - package don't evaluate the input if user event logging (the @-lu@ option) is - disabled. + in "Debug.Trace". It's faster than the String variants. + ["Debug.Trace.Binary"] Arbitary binary object logging available for GHC 8.8 or + later. Unlike the other tracing functions 'Debug.Trace.Binary.traceBinaryEvent' + takes an arbitrary 'Data.ByteString.ByteString' objects as opposed to UTF-8 + encoded strings. homepage: https://github.com/maoe/ghc-trace-events -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Mitsutoshi Aoe -maintainer: Mitsutoshi Aoe -copyright: Copyright (C) 2018 Mitsutoshi Aoe +maintainer: Mitsutoshi Aoe +copyright: Copyright (C) 2018-2019 Mitsutoshi Aoe category: Development, GHC, Trace build-type: Simple extra-source-files: CHANGELOG.md README.md -cabal-version: >= 1.10 tested-with: GHC == 7.10.3 || == 8.0.2 || == 8.2.2 - || == 8.4.3 + || == 8.4.4 + || == 8.6.5 + || == 8.8.1 +common base { build-depends: base >= 4.8 && < 4.14 } +common bytestring { build-depends: bytestring >= 0.9.2 && < 0.11 } +common criterion { build-depends: criterion < 1.6 } +common ghc-trace-events { build-depends: ghc-trace-events } +common text { build-depends: text >= 1.0.0 && < 1.3 } + library + import: + base + , bytestring + , text exposed-modules: Debug.Trace.ByteString + Debug.Trace.Flags Debug.Trace.String Debug.Trace.Text - Debug.Trace.Internal - build-depends: - base >= 4.8 && < 4.12 - , bytestring >= 0.9.2 && < 0.11 - , text >= 1.0.0 && < 1.3 + if impl(ghc >= 8.7) + exposed-modules: + Debug.Trace.Binary hs-source-dirs: src c-sources: cbits/tracing.c default-language: Haskell2010 benchmark bench-trace-enabled - type: exitcode-stdio-1.0 - build-depends: + import: base , bytestring , criterion , ghc-trace-events + type: exitcode-stdio-1.0 ghc-options: -eventlog -threaded "-with-rtsopts=-l" main-is: bench-trace.hs hs-source-dirs: benchmarks default-language: Haskell2010 benchmark bench-trace-disabled - type: exitcode-stdio-1.0 - build-depends: + import: base , bytestring , criterion , ghc-trace-events + type: exitcode-stdio-1.0 ghc-options: -threaded main-is: bench-trace.hs hs-source-dirs: benchmarks diff --git a/src/Debug/Trace/Binary.hs b/src/Debug/Trace/Binary.hs new file mode 100644 --- /dev/null +++ b/src/Debug/Trace/Binary.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +module Debug.Trace.Binary + ( traceBinaryEvent + , traceBinaryEventIO + ) where +import Control.Monad (when) +import GHC.Exts (Ptr(..), Int(..), traceBinaryEvent#) +import GHC.IO (IO(..)) +import qualified System.IO.Unsafe as Unsafe + +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as BU + +import Debug.Trace.Flags (userTracingEnabled) + +-- | The 'traceBinaryEvent' function behaves like +-- 'Debug.Trace.ByteString.traceEvent' but with the difference that the message +-- is a binary object rather than a UTF-8 encoded string. +-- +-- It is suitable for use in pure code. In an IO context use +-- 'traceBinaryEventIO' instead. +-- +-- Note that when using GHC's SMP runtime, it is possible (but rare) to get +-- duplicate events emitted if two CPUs simultaneously evaluate the same thunk +-- that uses 'traceBinaryEvent'. +-- +-- Also note that this function doesn't evaluate the 'B.ByteString' if user +-- tracing in evnetlog is disabled. +-- +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. +traceBinaryEvent :: B.ByteString -> a -> a +traceBinaryEvent bytes a + | userTracingEnabled = Unsafe.unsafeDupablePerformIO $ do + traceBinaryEventIO bytes + return a + | otherwise = a +{-# NOINLINE traceBinaryEvent #-} + +-- | The 'traceBinaryEventIO' function emits a binary message to the eventlog, +-- if eventlog profiling is available and enabled at runtime. +-- +-- Compared to 'traceBinaryEvent', 'traceBinaryEventIO' sequences the event with +-- respect to other IO actions. +-- +-- Also note that this function doesn't evaluate the 'B.ByteString' if user +-- tracing in evnetlog is disabled. +-- +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. +traceBinaryEventIO :: B.ByteString -> IO () +traceBinaryEventIO bytes = when userTracingEnabled $ + BU.unsafeUseAsCStringLen bytes $ \(Ptr p, I# n) -> IO $ \s -> + case traceBinaryEvent# p n s of + s' -> (# s', () #) diff --git a/src/Debug/Trace/ByteString.hs b/src/Debug/Trace/ByteString.hs --- a/src/Debug/Trace/ByteString.hs +++ b/src/Debug/Trace/ByteString.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-| @@ -16,16 +17,16 @@ , unsafeTraceMarker , unsafeTraceMarkerIO ) where -import GHC.Base -import GHC.IO -import GHC.Ptr +import Control.Monad (when) +import GHC.Exts (Ptr(..), traceEvent#, traceMarker#) +import GHC.IO (IO(..)) import qualified GHC.RTS.Flags as Flags import qualified System.IO.Unsafe as Unsafe import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as BU -import Debug.Trace.Internal (userTracingEnabled) +import Debug.Trace.Flags (userTracingEnabled) -- | 'B.ByteString' variant of 'Debug.Trace.traceEvent'. -- @@ -35,8 +36,8 @@ -- Note that this function doesn't evaluate the 'B.ByteString' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceEvent :: B.ByteString -> a -> a traceEvent message a | userTracingEnabled = Unsafe.unsafeDupablePerformIO $ do @@ -53,8 +54,8 @@ -- Note that this function doesn't evaluate the 'B.ByteString' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceEventIO :: B.ByteString -> IO () traceEventIO message = when userTracingEnabled $ B.useAsCString message $ \(Ptr p) -> IO $ \s -> @@ -69,11 +70,11 @@ -- Note that this function doesn't evaluate the 'B.ByteString' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceMarker :: B.ByteString -> a -> a traceMarker message a - | userTracingEnabled = unsafeDupablePerformIO $ do + | userTracingEnabled = Unsafe.unsafeDupablePerformIO $ do traceMarkerIO message return a | otherwise = a @@ -87,8 +88,8 @@ -- Note that this function doesn't evaluate the 'B.ByteString' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceMarkerIO :: B.ByteString -> IO () traceMarkerIO message = when userTracingEnabled $ B.useAsCString message $ \(Ptr p) -> IO $ \s -> @@ -104,8 +105,8 @@ -- Note that this function doesn't evaluate the 'B.ByteString' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. unsafeTraceEvent :: B.ByteString -> a -> a unsafeTraceEvent message a | userTracingEnabled = Unsafe.unsafeDupablePerformIO $ do @@ -123,8 +124,8 @@ -- Note that this function doesn't evaluate the 'B.ByteString' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. unsafeTraceEventIO :: B.ByteString -> IO () unsafeTraceEventIO message = when userTracingEnabled $ BU.unsafeUseAsCString message $ \(Ptr p) -> IO $ \s -> @@ -140,8 +141,8 @@ -- Note that this function doesn't evaluate the 'B.ByteString' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. unsafeTraceMarker :: B.ByteString -> a -> a unsafeTraceMarker message a | userTracingEnabled = Unsafe.unsafeDupablePerformIO $ do @@ -159,8 +160,8 @@ -- Note that this function doesn't evaluate the 'B.ByteString' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. unsafeTraceMarkerIO :: B.ByteString -> IO () unsafeTraceMarkerIO message = when userTracingEnabled $ BU.unsafeUseAsCString message $ \(Ptr p) -> IO $ \s -> diff --git a/src/Debug/Trace/Flags.hs b/src/Debug/Trace/Flags.hs new file mode 100644 --- /dev/null +++ b/src/Debug/Trace/Flags.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE CPP #-} +{-| +Utility functions to inspect RTS flags +-} +module Debug.Trace.Flags + ( userTracingEnabled + ) where +import Foreign.C.Types +import Foreign.Marshal.Utils +#if !MIN_VERSION_base(4, 10, 0) +import Data.Word +#endif + +-- | Check if user tracing is enabled in event logging. Currently GHC RTS +-- doesn't modify the flag after the eventlog framework is initialized so making +-- this a constant value makes sense. +userTracingEnabled :: Bool +userTracingEnabled = toBool c_userTracingEnabled +{-# NOINLINE userTracingEnabled #-} + +#if MIN_VERSION_base(4, 10, 0) +type CBOOL = CBool +#else +type CBOOL = Word8 +#endif + +foreign import ccall "userTracingEnabled" c_userTracingEnabled :: CBOOL diff --git a/src/Debug/Trace/Internal.hs b/src/Debug/Trace/Internal.hs deleted file mode 100644 --- a/src/Debug/Trace/Internal.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE CPP #-} -{-| -Internal module that includes utility functions. --} -module Debug.Trace.Internal - ( userTracingEnabled - ) where -import Foreign.C.Types -import Foreign.Marshal.Utils -#if !MIN_VERSION_base(4, 10, 0) -import Data.Word -#endif - --- | Check if user tracing is enabled in event logging. -userTracingEnabled :: Bool -userTracingEnabled = toBool c_userTracingEnabled -{-# NOINLINE userTracingEnabled #-} - -#if MIN_VERSION_base(4, 10, 0) -type CBOOL = CBool -#else -type CBOOL = Word8 -#endif - -foreign import ccall "userTracingEnabled" c_userTracingEnabled :: CBOOL diff --git a/src/Debug/Trace/String.hs b/src/Debug/Trace/String.hs --- a/src/Debug/Trace/String.hs +++ b/src/Debug/Trace/String.hs @@ -12,7 +12,7 @@ import Control.Monad import qualified Debug.Trace as Base -import Debug.Trace.Internal (userTracingEnabled) +import Debug.Trace.Flags (userTracingEnabled) -- | Drop-in replacement for 'Debug.Trace.traceEvent' but is more efficient -- if user tracing in eventlog is disabled. @@ -20,8 +20,8 @@ -- Note that this function doesn't evaluate the 'String' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceEvent :: String -> a -> a traceEvent message a | userTracingEnabled = Base.traceEvent message a @@ -33,8 +33,8 @@ -- Note that this function doesn't evaluate the 'String' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceEventIO :: String -> IO () traceEventIO message = when userTracingEnabled $ Base.traceEventIO message @@ -44,8 +44,8 @@ -- Note that this function doesn't evaluate the 'String' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceMarker :: String -> a -> a traceMarker message a | userTracingEnabled = Base.traceMarker message a @@ -57,7 +57,7 @@ -- Note that this function doesn't evaluate the 'String' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceMarkerIO :: String -> IO () traceMarkerIO message = when userTracingEnabled $ Base.traceMarkerIO message diff --git a/src/Debug/Trace/Text.hs b/src/Debug/Trace/Text.hs --- a/src/Debug/Trace/Text.hs +++ b/src/Debug/Trace/Text.hs @@ -10,10 +10,10 @@ , traceMarker , traceMarkerIO ) where +import Control.Monad (when) import Foreign.C.String (CString) -import GHC.Base -import GHC.IO -import GHC.Ptr +import GHC.Exts (Ptr(..), traceEvent#, traceMarker#) +import GHC.IO (IO(..)) import qualified GHC.RTS.Flags as Flags import qualified System.IO.Unsafe as Unsafe @@ -21,7 +21,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE -import Debug.Trace.Internal (userTracingEnabled) +import Debug.Trace.Flags (userTracingEnabled) -- | 'T.Text' variant of 'Debug.Trace.traceEvent'. -- @@ -31,8 +31,8 @@ -- Note that this function doesn't evaluate the 'T.Text' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceEvent :: T.Text -> a -> a traceEvent message a | userTracingEnabled = Unsafe.unsafeDupablePerformIO $ do @@ -49,8 +49,8 @@ -- Note that this function doesn't evaluate the 'T.Text' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceEventIO :: T.Text -> IO () traceEventIO message = when userTracingEnabled $ withCString message $ \(Ptr p) -> IO $ \s -> @@ -65,11 +65,11 @@ -- Note that this function doesn't evaluate the 'T.Text' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceMarker :: T.Text -> a -> a traceMarker message a - | userTracingEnabled = unsafeDupablePerformIO $ do + | userTracingEnabled = Unsafe.unsafeDupablePerformIO $ do traceMarkerIO message return a | otherwise = a @@ -83,8 +83,8 @@ -- Note that this function doesn't evaluate the 'T.Text' if user tracing -- in eventlog is disabled. -- --- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS generates a --- broken evnetlog. +-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS +-- generates a broken eventlog. traceMarkerIO :: T.Text -> IO () traceMarkerIO message = when userTracingEnabled $ withCString message $ \(Ptr p) -> IO $ \s ->