ghc-trace-events (empty) → 0.0.0

raw patch · 11 files changed

+460/−0 lines, 11 filesdep +basedep +bytestringdep +criterionsetup-changed

Dependencies added: base, bytestring, criterion, ghc-trace-events, text

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• README.md +1/−0
• Setup.hs +2/−0
• benchmarks/bench-trace.hs +43/−0
• cbits/tracing.c +6/−0
• ghc-trace-events.cabal +70/−0
• src/Debug/Trace/ByteString.hs +144/−0
• src/Debug/Trace/Internal.hs +25/−0
• src/Debug/Trace/String.hs +51/−0
• src/Debug/Trace/Text.hs +83/−0

@@ -0,0 +1,5 @@+# Revision history for ghc-trace-events++## v0.0.0 - 2018-05-21++* First version

@@ -0,0 +1,30 @@+Copyright (c) 2018, Mitsutoshi Aoe++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Mitsutoshi Aoe nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,1 @@+# ghc-trace-events

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+import Criterion.Main++import qualified Debug.Trace as Base+import qualified Debug.Trace.ByteString as B+import qualified Debug.Trace.String as S+import qualified Debug.Trace.Text as T++import qualified Debug.Trace.Internal as I++main :: IO ()+main = do+  putStrLn $ "userTracingEnabled: " ++ show I.userTracingEnabled+  defaultMain+    [ bgroup "traceEvent"+      [ bench "Base" $ whnf (Base.traceEvent "Hello") ()+      , bench "String" $ whnf (S.traceEvent "Hello") ()+      , bench "ByteString" $ whnf (B.traceEvent "Hello") ()+      , bench "ByteString/Unsafe" $ whnf (B.unsafeTraceEvent "Hello") ()+      , bench "Text" $ whnf (T.traceEvent "Hello") ()+      ]+    , bgroup "traceEventIO"+      [ bench "Base" $ nfIO $ Base.traceEventIO "Hello"+      , bench "String" $ nfIO $ S.traceEventIO "Hello"+      , bench "ByteString" $ nfIO $ B.traceEventIO "Hello"+      , bench "ByteString/Unsafe" $ nfIO $ B.unsafeTraceEventIO "Hello"+      , bench "Text" $ nfIO $ T.traceEventIO "Hello"+      ]+    , bgroup "traceMarker"+      [ bench "Base" $ whnf (Base.traceMarker "Hello") ()+      , bench "String" $ whnf (S.traceMarker "Hello") ()+      , bench "ByteString" $ whnf (B.traceMarker "Hello") ()+      , bench "ByteString/Unsafe" $ whnf (B.unsafeTraceMarker "Hello") ()+      , bench "Text" $ whnf (T.traceMarker "Hello") ()+      ]+    , bgroup "traceMarkerIO"+      [ bench "Base" $ nfIO $ Base.traceMarkerIO "Hello"+      , bench "String" $ nfIO $ S.traceMarkerIO "Hello"+      , bench "ByteString" $ nfIO $ B.traceMarkerIO "Hello"+      , bench "ByteString/Unsafe" $ nfIO $ B.unsafeTraceMarkerIO "Hello"+      , bench "Text" $ nfIO $ T.traceMarkerIO "Hello"+      ]+    ]

@@ -0,0 +1,6 @@+#include <stdbool.h>+#include "Rts.h"++bool userTracingEnabled() {+  return RtsFlags.TraceFlags.user;+}

@@ -0,0 +1,70 @@+name: ghc-trace-events+version: 0.0.0+synopsis: Faster replacements for traceEvent and traceEventMarker+description: This library provies 3 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.Text"] 'Data.Text.Text' variants of the event tracing functions+  in "Debug.Trace".+homepage: https://github.com/maoe/ghc-trace-events+license: BSD3+license-file: LICENSE+author: Mitsutoshi Aoe+maintainer: Mitsutoshi Aoe <maoe@foldr.in>+copyright: Copyright (C) 2018 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.2++library+  exposed-modules:+    Debug.Trace.ByteString+    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+  hs-source-dirs: src+  c-sources: cbits/tracing.c+  default-language: Haskell2010++benchmark bench-trace-enabled+  type: exitcode-stdio-1.0+  build-depends:+      base+    , bytestring+    , criterion+    , ghc-trace-events+  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:+      base+    , bytestring+    , criterion+    , ghc-trace-events+  ghc-options: -threaded+  main-is: bench-trace.hs+  hs-source-dirs: benchmarks+  default-language: Haskell2010++source-repository head+  type: git+  branch: develop+  location: https://github.com/maoe/ghc-trace-events.git

@@ -0,0 +1,144 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-|+'B.ByteString' variants of the tracing functions in "Debug.Trace".+-}+module Debug.Trace.ByteString+  ( traceEvent+  , traceEventIO++  , traceMarker+  , traceMarkerIO++  , unsafeTraceEvent+  , unsafeTraceEventIO++  , unsafeTraceMarker+  , unsafeTraceMarkerIO+  ) where+import GHC.Base+import GHC.IO+import GHC.Ptr+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)++-- | 'B.ByteString' variant of 'Debug.Trace.traceEvent'.+--+-- \(O(n)\) This function copies the 'B.ByteString' to convert it to a+-- null-terminated 'Foreign.C.Types.CString'.+--+-- Note that this function doesn't evaluate the 'B.ByteString' if user tracing+-- in eventlog is disabled.+traceEvent :: B.ByteString -> a -> a+traceEvent message a+  | userTracingEnabled = Unsafe.unsafeDupablePerformIO $ do+    traceEventIO message+    return a+  | otherwise = a+{-# NOINLINE traceEvent #-}++-- | 'B.ByteString' variant of 'Debug.Trace.traceEventIO'.+--+-- \(O(n)\) This function copies the 'B.ByteString' to convert it to a+-- null-terminated 'Foreign.C.Types.CString'.+--+-- Note that this function doesn't evaluate the 'B.ByteString' if user tracing+-- in eventlog is disabled.+traceEventIO :: B.ByteString -> IO ()+traceEventIO message = when userTracingEnabled $+  B.useAsCString message $ \(Ptr p) -> IO $ \s ->+    case traceEvent# p s of+      s' -> (# s', () #)++-- | 'B.ByteString' variant of 'Debug.Trace.traceMarker'.+--+-- \(O(n)\) This function copies the 'B.ByteString' to convert it to a+-- null-terminated 'Foreign.C.Types.CString'.+--+-- Note that this function doesn't evaluate the 'B.ByteString' if user tracing+-- in eventlog is disabled.+traceMarker :: B.ByteString -> a -> a+traceMarker message a+  | userTracingEnabled = unsafeDupablePerformIO $ do+    traceMarkerIO message+    return a+  | otherwise = a+{-# NOINLINE traceMarker #-}++-- | 'B.ByteString' variant of 'Debug.Trace.traceMarkerIO'.+--+-- \(O(n)\) This function copies the 'B.ByteString' to convert it to a+-- null-terminated 'Foreign.C.Types.CString'.+--+-- Note that this function doesn't evaluate the 'B.ByteString' if user tracing+-- in eventlog is disabled.+traceMarkerIO :: B.ByteString -> IO ()+traceMarkerIO message = when userTracingEnabled $+  B.useAsCString message $ \(Ptr p) -> IO $ \s ->+    case traceMarker# p s of+      s' -> (# s', () #)++-- | 'B.ByteString' variant of 'Debug.Trace.traceEvent'.+--+-- \(O(1)\) This function is unsafe in the way that it doesn't ensure the input+-- string to be null-terminated. It is user's responsibility to null-terminate+-- the input.+--+-- Note that this function doesn't evaluate the 'B.ByteString' if user tracing+-- in eventlog is disabled.+unsafeTraceEvent :: B.ByteString -> a -> a+unsafeTraceEvent message a+  | userTracingEnabled = Unsafe.unsafeDupablePerformIO $ do+    unsafeTraceEventIO message+    return a+  | otherwise = a+{-# NOINLINE unsafeTraceEvent #-}++-- | 'B.ByteString' variant of 'Debug.Trace.traceEventIO'.+--+-- \(O(1)\) This function is unsafe in the way that it doesn't ensure the input+-- string to be null-terminated. It is user's responsibility to null-terminate+-- the input.+--+-- Note that this function doesn't evaluate the 'B.ByteString' if user tracing+-- in eventlog is disabled.+unsafeTraceEventIO :: B.ByteString -> IO ()+unsafeTraceEventIO message = when userTracingEnabled $+  BU.unsafeUseAsCString message $ \(Ptr p) -> IO $ \s ->+    case traceEvent# p s of+      s' -> (# s', () #)++-- | 'B.ByteString' variant of 'Debug.Trace.traceMarker'.+--+-- \(O(1)\) This function is unsafe in the way that it doesn't ensure the input+-- string to be null-terminated. It is user's responsibility to null-terminate+-- the input.+--+-- Note that this function doesn't evaluate the 'B.ByteString' if user tracing+-- in eventlog is disabled.+unsafeTraceMarker :: B.ByteString -> a -> a+unsafeTraceMarker message a+  | userTracingEnabled = Unsafe.unsafeDupablePerformIO $ do+    unsafeTraceEventIO message+    return a+  | otherwise = a+{-# NOINLINE unsafeTraceMarker #-}++-- | 'B.ByteString' variant of 'Debug.Trace.traceMarkerIO'.+--+-- \(O(1)\) This function is unsafe in the way that it doesn't ensure the input+-- string to be null-terminated. It is user's responsibility to null-terminate+-- the input.+--+-- Note that this function doesn't evaluate the 'B.ByteString' if user tracing+-- in eventlog is disabled.+unsafeTraceMarkerIO :: B.ByteString -> IO ()+unsafeTraceMarkerIO message = when userTracingEnabled $+  BU.unsafeUseAsCString message $ \(Ptr p) -> IO $ \s ->+    case traceMarker# p s of+      s' -> (# s', () #)

@@ -0,0 +1,25 @@+{-# 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

@@ -0,0 +1,51 @@+{-|+Drop-in replacements for the event tracing functions in "Debug.Trace" but are+faster when user tracing is disabled.+-}+module Debug.Trace.String+  ( traceEvent+  , traceEventIO++  , traceMarker+  , traceMarkerIO+  ) where+import Control.Monad+import qualified Debug.Trace as Base++import Debug.Trace.Internal (userTracingEnabled)++-- | Drop-in replacement for 'Debug.Trace.traceEvent' but is more efficient+-- if user tracing in eventlog is disabled.+--+-- Note that this function doesn't evaluate the 'String' if user tracing+-- in eventlog is disabled.+traceEvent :: String -> a -> a+traceEvent message a+  | userTracingEnabled = Base.traceEvent message a+  | otherwise = a++-- | Drop-in replacement for 'Debug.Trace.traceEventIO' but is more efficient+-- if user tracing in eventlog is disabled.+--+-- Note that this function doesn't evaluate the 'String' if user tracing+-- in eventlog is disabled.+traceEventIO :: String -> IO ()+traceEventIO message = when userTracingEnabled $ Base.traceEventIO message++-- | Drop-in replacement for 'Debug.Trace.traceMarker' but is more efficient+-- if user tracing in eventlog is disabled.+--+-- Note that this function doesn't evaluate the 'String' if user tracing+-- in eventlog is disabled.+traceMarker :: String -> a -> a+traceMarker message a+  | userTracingEnabled = Base.traceMarker message a+  | otherwise = a++-- | Drop-in replacement for 'Debug.Trace.traceMarkerIO' but is more efficient+-- if user tracing in eventlog is disabled.+--+-- Note that this function doesn't evaluate the 'String' if user tracing+-- in eventlog is disabled.+traceMarkerIO :: String -> IO ()+traceMarkerIO message = when userTracingEnabled $ Base.traceMarkerIO message

@@ -0,0 +1,83 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-|+'T.Text' variants of the tracing functions in "Debug.Trace".+-}+module Debug.Trace.Text+  ( traceEvent+  , traceEventIO++  , traceMarker+  , traceMarkerIO+  ) where+import Foreign.C.String (CString)+import GHC.Base+import GHC.IO+import GHC.Ptr+import qualified GHC.RTS.Flags as Flags+import qualified System.IO.Unsafe as Unsafe++import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++import Debug.Trace.Internal (userTracingEnabled)++-- | 'T.Text' variant of 'Debug.Trace.traceEvent'.+--+-- \(O(n)\) This function marshals the 'T.Text' into a 'B.ByteString' and+-- convert it into a null-terminated 'Foreign.C.Types.CString'.+--+-- Note that this function doesn't evaluate the 'T.Text' if user tracing+-- in eventlog is disabled.+traceEvent :: T.Text -> a -> a+traceEvent message a+  | userTracingEnabled = Unsafe.unsafeDupablePerformIO $ do+    traceEventIO message+    return a+  | otherwise = a+{-# NOINLINE traceEvent #-}++-- | 'T.Text' variant of 'Debug.Trace.traceEventIO'.+--+-- \(O(n)\) This function marshals the 'T.Text' into a 'B.ByteString' and+-- convert it into a null-terminated 'Foreign.C.Types.CString'.+--+-- Note that this function doesn't evaluate the 'T.Text' if user tracing+-- in eventlog is disabled.+traceEventIO :: T.Text -> IO ()+traceEventIO message = when userTracingEnabled $+  withCString message $ \(Ptr p) -> IO $ \s ->+    case traceEvent# p s of+      s' -> (# s', () #)++-- | 'T.Text' variant of 'Debug.Trace.traceMarker'.+--+-- \(O(n)\) This function marshals the 'T.Text' into a 'B.ByteString' and+-- convert it into a null-terminated 'Foreign.C.Types.CString'.+--+-- Note that this function doesn't evaluate the 'T.Text' if user tracing+-- in eventlog is disabled.+traceMarker :: T.Text -> a -> a+traceMarker message a+  | userTracingEnabled = unsafeDupablePerformIO $ do+    traceMarkerIO message+    return a+  | otherwise = a+{-# NOINLINE traceMarker #-}++-- | 'T.Text' variant of 'Debug.Trace.traceMarkerIO'.+--+-- \(O(n)\) This function marshals the 'T.Text' into a 'B.ByteString' and+-- convert it into a null-terminated 'Foreign.C.Types.CString'.+--+-- Note that this function doesn't evaluate the 'T.Text' if user tracing+-- in eventlog is disabled.+traceMarkerIO :: T.Text -> IO ()+traceMarkerIO message = when userTracingEnabled $+  withCString message $ \(Ptr p) -> IO $ \s ->+    case traceMarker# p s of+      s' -> (# s', () #)++withCString :: T.Text -> (CString -> IO a) -> IO a+withCString text = B.useAsCString (TE.encodeUtf8 text)