ghc-trace-events 0.0.0.1 → 0.1.0

raw patch · 9 files changed

+190/−94 lines, 9 filesdep ~basedep ~bytestringdep ~criterionPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, criterion

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• benchmarks/bench-trace.hs +10/−2
• ghc-trace-events.cabal +45/−24
• src/Debug/Trace/Binary.hs +56/−0
• src/Debug/Trace/ByteString.hs +22/−21
• src/Debug/Trace/Flags.hs +27/−0
• src/Debug/Trace/Internal.hs +0/−25
• src/Debug/Trace/String.hs +9/−9
• src/Debug/Trace/Text.hs +13/−13

@@ -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

@@ -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     ]

@@ -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+  <http://hackage.haskell.org/package/base/docs/Debug-Trace.html#g:2 eventlog tracing functions in base>,+  all the tracing functions in this library don't evaluate the input if user+  event logging (the+  <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/runtime_control.html#rts-flag--l%20⟨flags⟩ -lu>+  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 <maoe@foldr.in>-copyright: Copyright (C) 2018 Mitsutoshi Aoe+maintainer: Mitsutoshi Aoe <me@maoe.name>+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

@@ -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', () #)

@@ -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 ->

@@ -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

@@ -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

@@ -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

@@ -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 ->