[Git][ghc/ghc][wip/T17949] 4 commits: T17949 mark getTraceFlags as inlinable

[Daneel S. Yaitskov]

Daneel S. Yaitskov pushed to branch wip/T17949 at Glasgow Haskell Compiler / GHC


Commits:
aef64146 by Daneel Yaitskov at 2020-06-01T18:39:28-07:00
T17949 mark getTraceFlags as inlinable

- - - - -
4c7d1c70 by Daneel Yaitskov at 2020-06-01T18:42:46-07:00
T17949 comment userTracingEnabled

- - - - -
9cc84375 by Daneel Yaitskov at 2020-06-01T18:44:14-07:00
T17949 inline whenEventlog

- - - - -
f7d009e3 by Daneel Yaitskov at 2020-06-01T18:44:50-07:00
T17949 export userTracingEnabled

- - - - -


2 changed files:

- libraries/base/Debug/Trace.hs
- libraries/base/GHC/RTS/Flags.hsc


Changes:

=====================================
libraries/base/Debug/Trace.hs
=====================================
@@ -42,6 +42,8 @@ module Debug.Trace (
         -- $markers
         traceMarker,
         traceMarkerIO,
+
+        userTracingEnabled,
   ) where
 
 import System.IO.Unsafe
@@ -75,19 +77,13 @@ import Data.List (null, partition)
 -- Some implementations of these functions may decorate the string that\'s
 -- output to indicate that you\'re tracing.
 
-userTracingEnabled :: Bool
-userTracingEnabled = unsafeDupablePerformIO $ user <$!> inline getTraceFlags
-
--- | The 'whenEventlog' function runs the argument action
+-- | The 'userTracingEnabled' function returns True
 -- if eventlogging (+RTS -l) is enabled.
+-- It doens't reflect following getTraceFlags updates.
 --
 -- @since 4.14.0.0
-{-# INLINE whenEventlog #-}
-whenEventlog :: IO () -> IO ()
-whenEventlog logAction = do
-  if userTracingEnabled
-  then logAction
-  else return ()
+userTracingEnabled :: Bool
+userTracingEnabled = unsafeDupablePerformIO $ user <$!> inline getTraceFlags
 
 -- | The 'traceIO' function outputs the trace message from the IO monad.
 -- This sequences the output with respect to other IO actions.
@@ -283,8 +279,10 @@ traceEvent msg expr = unsafeDupablePerformIO $ do
 -- @since 4.5.0.0
 traceEventIO :: String -> IO ()
 traceEventIO msg =
-  whenEventlog $ GHC.Foreign.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
-    case traceEvent# p s of s' -> (# s', () #)
+  if userTracingEnabled
+     then GHC.Foreign.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
+            case traceEvent# p s of s' -> (# s', () #)
+     else return ()
 
 -- $markers
 --
@@ -333,5 +331,7 @@ traceMarker msg expr = unsafeDupablePerformIO $ do
 -- @since 4.7.0.0
 traceMarkerIO :: String -> IO ()
 traceMarkerIO msg =
-  whenEventlog $ GHC.Foreign.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
-    case traceMarker# p s of s' -> (# s', () #)
+  if userTracingEnabled
+     then GHC.Foreign.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
+            case traceMarker# p s of s' -> (# s', () #)
+     else return ()


=====================================
libraries/base/GHC/RTS/Flags.hsc
=====================================
@@ -535,6 +535,7 @@ getProfFlags = do
             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, retainerSelector} ptr)
             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, bioSelector} ptr)
 
+{-# INLINABLE getTraceFlags #-}
 getTraceFlags :: IO TraceFlags
 getTraceFlags = do
   let ptr = (#ptr RTS_FLAGS, TraceFlags) rtsFlagsPtr



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/480b208d78de5e236bd7e4fc682c83f05077b270...f7d009e39607862462205449a68744a23a66f73d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/480b208d78de5e236bd7e4fc682c83f05077b270...f7d009e39607862462205449a68744a23a66f73d
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200601/a68ab9d4/attachment-0001.html>