Skip to content

Commit

Permalink
Use ViewPatterns to reduce temporary bindings
Browse files Browse the repository at this point in the history
  • Loading branch information
maoe committed Nov 16, 2020
1 parent 09fca62 commit e08979e
Showing 1 changed file with 28 additions and 36 deletions.
64 changes: 28 additions & 36 deletions src/GHC/RTS/Events/Binary.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module GHC.RTS.Events.Binary
( -- * Readers
getHeader
Expand Down Expand Up @@ -912,13 +913,12 @@ putHeader (Header ets) = do
putMarker EVENT_HET_END
putMarker EVENT_HEADER_END
where
putEventType (EventType n d msz) = do
putEventType (EventType n (TE.encodeUtf8 -> d) msz) = do
putMarker EVENT_ET_BEGIN
putType n
putE $ fromMaybe 0xffff msz
let d' = TE.encodeUtf8 d
putE (fromIntegral $ B.length d' :: EventTypeDescLen)
putByteString d'
putE (fromIntegral $ B.length d :: EventTypeDescLen)
putByteString d
-- the event type header allows for extra data, which we don't use:
putE (0 :: Word32)
putMarker EVENT_ET_END
Expand Down Expand Up @@ -1136,11 +1136,10 @@ putEventSpec (WakeupThread t c) = do
putE t
putCap c

putEventSpec (ThreadLabel t l) = do
let l' = TE.encodeUtf8 l
putE (fromIntegral (B.length l') + sz_tid :: Word16)
putEventSpec (ThreadLabel t (TE.encodeUtf8 -> l)) = do
putE (fromIntegral (B.length l) + sz_tid :: Word16)
putE t
putByteString l'
putByteString l

putEventSpec Shutdown =
return ()
Expand Down Expand Up @@ -1246,25 +1245,22 @@ putEventSpec (CapsetRemoveCap cs cp) = do
putE cs
putCap cp

putEventSpec (RtsIdentifier cs rts) = do
let rts' = TE.encodeUtf8 rts
putE (fromIntegral (B.length rts') + sz_capset :: Word16)
putEventSpec (RtsIdentifier cs (TE.encodeUtf8 -> rts)) = do
putE (fromIntegral (B.length rts) + sz_capset :: Word16)
putE cs
putByteString rts'
putByteString rts

putEventSpec (ProgramArgs cs as) = do
let as' = map TE.encodeUtf8 as
let sz_args = sum (map ((+ 1) {- for \0 -} . B.length) as') - 1
putEventSpec (ProgramArgs cs (map TE.encodeUtf8 -> as)) = do
let sz_args = sum (map ((+ 1) {- for \0 -} . B.length) as) - 1
putE (fromIntegral sz_args + sz_capset :: Word16)
putE cs
mapM_ putByteString (intersperse "\0" as')
mapM_ putByteString (intersperse "\0" as)

putEventSpec (ProgramEnv cs es) = do
let es' = map TE.encodeUtf8 es
let sz_env = sum (map ((+ 1) {- for \0 -} . B.length) es') - 1
putEventSpec (ProgramEnv cs (map TE.encodeUtf8 -> es)) = do
let sz_env = sum (map ((+ 1) {- for \0 -} . B.length) es) - 1
putE (fromIntegral sz_env + sz_capset :: Word16)
putE cs
mapM_ putByteString $ intersperse "\0" es'
mapM_ putByteString $ intersperse "\0" es

putEventSpec (OsProcessPid cs pid) = do
putE cs
Expand All @@ -1279,20 +1275,17 @@ putEventSpec (WallClockTime cs sec nsec) = do
putE sec
putE nsec

putEventSpec (Message s) = do
let s' = TE.encodeUtf8 s
putE (fromIntegral (B.length s') :: Word16)
putByteString s'
putEventSpec (Message (TE.encodeUtf8 -> s)) = do
putE (fromIntegral (B.length s) :: Word16)
putByteString s

putEventSpec (UserMessage s) = do
let s' = TE.encodeUtf8 s
putE (fromIntegral (B.length s') :: Word16)
putByteString s'
putEventSpec (UserMessage (TE.encodeUtf8 -> s)) = do
putE (fromIntegral (B.length s) :: Word16)
putByteString s

putEventSpec (UserMarker s) = do
let s' = TE.encodeUtf8 s
putE (fromIntegral (B.length s') :: Word16)
putByteString s'
putEventSpec (UserMarker (TE.encodeUtf8 -> s)) = do
putE (fromIntegral (B.length s) :: Word16)
putByteString s

putEventSpec (UnknownEvent {}) = error "putEventSpec UnknownEvent"

Expand Down Expand Up @@ -1395,11 +1388,10 @@ putEventSpec (MerReleaseThread thread_id) =
putEventSpec MerCapSleeping = return ()
putEventSpec MerCallingMain = return ()

putEventSpec PerfName{..} = do
let name' = TE.encodeUtf8 name
putE (fromIntegral (B.length name') + sz_perf_num :: Word16)
putEventSpec PerfName{name = (TE.encodeUtf8 -> name), ..} = do
putE (fromIntegral (B.length name) + sz_perf_num :: Word16)
putE perfNum
putByteString name'
putByteString name

putEventSpec PerfCounter{..} = do
putE perfNum
Expand Down

0 comments on commit e08979e

Please sign in to comment.