bytezap 1.3.1 → 1.4.0

raw patch · 12 files changed

+675/−160 lines, 12 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• bytezap.cabal +5/−3
• src/Bytezap/Parser/Struct.hs +58/−8
• src/Bytezap/Parser/Struct/TypeLits/Bytes.hs +111/−61
• src/Bytezap/Poke.hs +34/−6
• src/Bytezap/PokeCPS.hs +153/−0
• src/Bytezap/Struct.hs +2/−2
• src/Bytezap/Struct/TypeLits/Bytes.hs +61/−48
• src/Bytezap/Write.hs +19/−17
• src/Bytezap/Write/Derived.hs +7/−7
• src/Bytezap/Write/Internal.hs +51/−8
• src/Tmp/BSExt.hs +168/−0

@@ -1,3 +1,9 @@+## 1.4.0 (2024-09-25)+* `Write` now takes a type-level `LengthType` to indicate how it should be used+* rewrite type-level bytestring parsing: now with error handling!+* re-fix GHC 9.8 build+* add some weird wip code for failable serializers+ ## 1.3.1 (2024-07-15) * fix building on GHC 9.8 and probably 9.10 

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.36.1. -- -- see: https://github.com/sol/hpack  name:           bytezap-version:        1.3.1+version:        1.4.0 synopsis:       Bytestring builder with zero intermediate allocation description:    Please see README.md. category:       Data, Serialization, Generics@@ -38,6 +38,7 @@       Bytezap.Poke.Derived.Endian       Bytezap.Poke.Json       Bytezap.Poke.KnownLen+      Bytezap.PokeCPS       Bytezap.Struct       Bytezap.Struct.Generic       Bytezap.Struct.TypeLits.Bytes@@ -50,6 +51,7 @@       Raehik.Compat.Data.Word.ByteSwap       Raehik.Compat.GHC.Exts.GHC908MemcpyPrimops       Raehik.Compat.GHC.Exts.GHC910UnalignedAddrPrimops+      Tmp.BSExt       Util.TypeNats   other-modules:       Paths_bytezap@@ -70,7 +72,7 @@   c-sources:       cbits/aligned-static-hs-data.c   build-depends:-      base >=4.18.0.0 && <4.20+      base >=4.18.0.0 && <4.21     , bytestring >=0.11.5.3 && <0.13.0.0     , defun-core ==0.1.*     , generic-type-functions >=0.1.0 && <0.2

@@ -23,6 +23,11 @@  import Raehik.Compat.Data.Primitive.Types +import Data.Bits+  ( Bits( (.&.), unsafeShiftR, xor )+  , FiniteBits(countTrailingZeros)+  )+ type PureMode = Proxy# Void type IOMode   = State# RealWorld type STMode s = State# s@@ -34,6 +39,9 @@     -> st    {- ^ state token -}     -> Res# st e a +-- | Like flatparse, but no buffer length (= no buffer overflow checking), and+--   no 'Addr#' on success (= no dynamic length parses).+-- -- we take a 'ForeignPtrContents' because it lets us create bytestrings without -- copying if we want. it's useful newtype ParserT (st :: ZeroBitType) e a =@@ -64,6 +72,8 @@   (# st, ResI# e a #)  -- | Primitive parser result.+--+-- Like flatparse, but no 'Addr#' on success. type ResI# e a =   (#     (# a #)@@ -107,8 +117,8 @@ unsafeRunParser' base# fpc (ParserT p) =     case p fpc base# 0# proxy# of       OK#   _st1 a -> OK a-      Fail# _st1   -> Fail       Err#  _st1 e -> Err e+      Fail# _st1   -> Fail  -- | Higher-level boxed data type for parsing results. data Result e a =@@ -127,16 +137,17 @@ sequenceParsers (I# len#) f (ParserT pa) (ParserT pb) =     ParserT \fpc base os# st0 ->         case pa fpc base os# st0 of-          Fail# st1 ->  Fail# st1-          Err# st1 e -> Err# st1 e           OK# st1 a ->             case pb fpc base (os# +# len#) st1 of+              OK# st2 b -> OK# st2 (f a b)               Fail# st2 ->  Fail# st2               Err# st2 e -> Err# st2 e-              OK# st2 b -> OK# st2 (f a b)+          Err# st1 e -> Err# st1 e+          Fail# st1 ->  Fail# st1  -- TODO using indexWord8OffAddrAs to permit pure mode. flatparse does this (at -- least for integers). guess it's OK?+-- TODO this doesn't use the state token. scary. prim :: forall a st e. Prim' a => ParserT st e a prim = ParserT \_fpc base os st ->     case indexWord8OffAddrAs# base os of a -> OK# st a@@ -145,16 +156,55 @@ lit :: Eq a => a -> ParserT st e a -> ParserT st e () lit al (ParserT p) = ParserT \fpc base os st0 ->     case p fpc base os st0 of-      Fail# st1    -> Fail# st1-      Err#  st1 e  -> Err#  st1 e       OK#   st1 ar -> if al == ar then OK# st1 () else Fail# st1+      Err#  st1 e  -> Err#  st1 e+      Fail# st1    -> Fail# st1  -- | parse literal (CPS) withLit     :: Eq a => Int# -> a -> ParserT st e a -> ParserT st e r -> ParserT st e r withLit len# al (ParserT p) (ParserT pCont) = ParserT \fpc base os# st0 ->     case p fpc base os# st0 of-      Fail# st1    -> Fail# st1-      Err#  st1 e  -> Err#  st1 e       OK#   st1 ar ->         if al == ar then pCont fpc base (os# +# len#) st1 else Fail# st1+      Err#  st1 e  -> Err#  st1 e+      Fail# st1    -> Fail# st1++{- | parse literal, return first (leftmost) failing byte on error (CPS)++This can be used to parse large literals via chunking, rather than byte-by-byte,+while retaining useful error behaviour.++We don't check equality with XOR even though we use that when handling errors,+because it's hard to tell if it would be faster with modern CPUs and compilers.+-}+withLitErr+    :: (Num a, FiniteBits a)+    => (Int -> a -> e)+    -> Int# -> a -> (Addr# -> Int# -> a) -> ParserT st e r -> ParserT st e r+withLitErr fErr len# aLit p (ParserT pCont) = ParserT \fpc base# os# st ->+    let aParsed = p base# os#+    in  if   aLit == aParsed+        then pCont fpc base# (os# +# len#) st+        else let idxFail = firstNonMatchByteIdx aLit aParsed+                 bFailed = unsafeByteAt aParsed idxFail+             in  Err# st (fErr idxFail bFailed)+{-# INLINE withLitErr #-}++-- | Given two non-equal words @wActual@ and @wExpect@, return the index of the+--   first non-matching byte. Zero indexed.+--+-- If both words are equal, returns word_size (e.g. 4 for 'Word32').+firstNonMatchByteIdx :: FiniteBits a => a -> a -> Int+firstNonMatchByteIdx wExpect wActual =+    countTrailingZeros (wExpect `xor` wActual) `unsafeShiftR` 3+{-# INLINE firstNonMatchByteIdx #-}++-- | Get the byte at the given index.+--+-- The return value is guaranteed to be 0x00 - 0xFF (inclusive).+--+-- TODO meaning based on endianness?+unsafeByteAt :: (Num a, Bits a) => a -> Int -> a+unsafeByteAt a idx = (a `unsafeShiftR` (idx * 8)) .&. 0xFF+{-# INLINE unsafeByteAt #-}

@@ -1,96 +1,146 @@-{- | Efficient type-level bytestring parsing.+{-# LANGUAGE AllowAmbiguousTypes, UndecidableInstances #-} -One may implement this using the type-level serializing, but mirroring it for-parsing does less work and allocation.--}+{- | Efficient type-level bytestring parsing via chunking. -{-# LANGUAGE AllowAmbiguousTypes, UndecidableInstances #-}+See 'Bytezap.Struct.TypeLits.Bytes' for an explanation on the chunking design. -module Bytezap.Parser.Struct.TypeLits.Bytes where+On mismatch, the index of the failing byte and its value are returned. (This is+over-engineered to be extremely efficient.) -import Data.Type.Byte-import Bytezap.Parser.Struct ( ParserT, prim, withLit, constParse )-import Numeric.Natural ( Natural )-import Data.Void ( Void )+Type classes take a 'Natural' for tracking the current index in the type-level+bytestring. We do this on the type level for performance. Use @\@0@ when+calling. -class ParseReifyBytesW64 (ns :: [Natural]) where-    parseReifyBytesW64 :: ParserT st Void ()+The parsers take an error wrapper function to enable wrapping the error into any+parser with confidence that it won't do extra allocations/wrapping. +The parsers here either return the unit '()' or a pretty error. No 'Fail#'.++TODO check generated Core, assembly+-}++module Bytezap.Parser.Struct.TypeLits.Bytes+  ( ParseReifyBytesW64(parseReifyBytesW64)+  , ParseReifyBytesW32(parseReifyBytesW32)+  , ParseReifyBytesW16(parseReifyBytesW16)+  , ParseReifyBytesW8(parseReifyBytesW8)+  ) where++import Bytezap.Parser.Struct+import Data.Word ( Word8 )+import GHC.TypeNats ( Natural, type (+), KnownNat )+import Data.Type.Byte ( ReifyW8, reifyW64, reifyW32, reifyW16, reifyW8 )+import GHC.Exts ( (+#), Int(I#), Int#, Addr# )+import Util.TypeNats ( natValInt )+import Raehik.Compat.Data.Primitive.Types ( indexWord8OffAddrAs# )+import Data.Bits++-- | Parse a type-level bytestring, largest grouping 'Word64'.+class ParseReifyBytesW64 (idx :: Natural) (bs :: [Natural]) where+    parseReifyBytesW64 :: (Int -> Word8 -> e) -> ParserT st e ()+ -- | Enough bytes to make a 'Word64'. instance {-# OVERLAPPING #-}-  ( ReifyW8 n1-  , ReifyW8 n2-  , ReifyW8 n3-  , ReifyW8 n4-  , ReifyW8 n5-  , ReifyW8 n6-  , ReifyW8 n7-  , ReifyW8 n8-  , ParseReifyBytesW64 ns-  ) => ParseReifyBytesW64 (n1 ': n2 ': n3 ': n4 ': n5 ': n6 ': n7 ': n8 ': ns) where+  ( ReifyW8 b0+  , ReifyW8 b1+  , ReifyW8 b2+  , ReifyW8 b3+  , ReifyW8 b4+  , ReifyW8 b5+  , ReifyW8 b6+  , ReifyW8 b7+  , KnownNat idx+  , ParseReifyBytesW64 (idx+8) bs+  ) => ParseReifyBytesW64 idx (b0 ': b1 ': b2 ': b3 ': b4 ': b5 ': b6 ': b7 ': bs) where     {-# INLINE parseReifyBytesW64 #-}-    parseReifyBytesW64 = withLit 8# (reifyW64 @n1 @n2 @n3 @n4 @n5 @n6 @n7 @n8)-        prim (parseReifyBytesW64 @ns)+    parseReifyBytesW64 = parseReifyBytesHelper @idx @8+        wExpect indexWord8OffAddrAs# (parseReifyBytesW64 @(idx+8) @bs)+      where+        wExpect = reifyW64 @b0 @b1 @b2 @b3 @b4 @b5 @b6 @b7  -- | Try to group 'Word32's next.-instance ParseReifyBytesW32 ns => ParseReifyBytesW64 ns where+instance ParseReifyBytesW32 idx bs => ParseReifyBytesW64 idx bs where     {-# INLINE parseReifyBytesW64 #-}-    parseReifyBytesW64 = parseReifyBytesW32 @ns+    parseReifyBytesW64 = parseReifyBytesW32 @idx @bs --- | Serialize a type-level bytestring, largest grouping 'Word32'.-class ParseReifyBytesW32 (ns :: [Natural]) where-    parseReifyBytesW32 :: ParserT st e ()+-- | Parse a type-level bytestring, largest grouping 'Word32'.+class ParseReifyBytesW32 (idx :: Natural) (bs :: [Natural]) where+    parseReifyBytesW32 :: (Int -> Word8 -> e) -> ParserT st e ()  -- | Enough bytes to make a 'Word32'. instance {-# OVERLAPPING #-}-  ( ReifyW8 n1-  , ReifyW8 n2-  , ReifyW8 n3-  , ReifyW8 n4-  , ParseReifyBytesW32 ns-  ) => ParseReifyBytesW32 (n1 ': n2 ': n3 ': n4 ': ns) where+  ( ReifyW8 b0+  , ReifyW8 b1+  , ReifyW8 b2+  , ReifyW8 b3+  , KnownNat idx+  , ParseReifyBytesW32 (idx+4) bs+  ) => ParseReifyBytesW32 idx (b0 ': b1 ': b2 ': b3 ': bs) where     {-# INLINE parseReifyBytesW32 #-}-    parseReifyBytesW32 = withLit 4# (reifyW32 @n1 @n2 @n3 @n4)-        prim (parseReifyBytesW32 @ns)+    parseReifyBytesW32 = parseReifyBytesHelper @idx @4+        wExpect indexWord8OffAddrAs# (parseReifyBytesW32 @(idx+4) @bs)+      where+        wExpect = reifyW32 @b0 @b1 @b2 @b3  -- | Try to group 'Word16's next.-instance ParseReifyBytesW16 ns => ParseReifyBytesW32 ns where+instance ParseReifyBytesW16 idx bs => ParseReifyBytesW32 idx bs where     {-# INLINE parseReifyBytesW32 #-}-    parseReifyBytesW32 = parseReifyBytesW16 @ns+    parseReifyBytesW32 = parseReifyBytesW16 @idx @bs --- | Serialize a type-level bytestring, largest grouping 'Word16'.-class ParseReifyBytesW16 (ns :: [Natural]) where-    parseReifyBytesW16 :: ParserT st e ()+-- | Parse a type-level bytestring, largest grouping 'Word16'.+class ParseReifyBytesW16 (idx :: Natural) (bs :: [Natural]) where+    parseReifyBytesW16 :: (Int -> Word8 -> e) -> ParserT st e ()  -- | Enough bytes to make a 'Word16'. instance {-# OVERLAPPING #-}-  ( ReifyW8 n1-  , ReifyW8 n2-  , ParseReifyBytesW16 ns-  ) => ParseReifyBytesW16 (n1 ': n2 ': ns) where+  ( ReifyW8 b0+  , ReifyW8 b1+  , KnownNat idx+  , ParseReifyBytesW16 (idx+2) bs+  ) => ParseReifyBytesW16 idx (b0 ': b1 ': bs) where     {-# INLINE parseReifyBytesW16 #-}-    parseReifyBytesW16 = withLit 2# (reifyW16 @n1 @n2)-        prim (parseReifyBytesW16 @ns)+    parseReifyBytesW16 = parseReifyBytesHelper @idx @2+        wExpect indexWord8OffAddrAs# (parseReifyBytesW16 @(idx+2) @bs)+      where+        wExpect = reifyW16 @b0 @b1 --- | Reify byte-by-byte next.-instance ParseReifyBytesW8 ns => ParseReifyBytesW16 ns where+-- | Parse byte-by-byte next.+instance ParseReifyBytesW8 idx bs => ParseReifyBytesW16 idx bs where     {-# INLINE parseReifyBytesW16 #-}-    parseReifyBytesW16 = parseReifyBytesW8 @ns+    parseReifyBytesW16 = parseReifyBytesW8 @idx @bs  -- | Serialize a type-level bytestring, byte-by-byte.-class ParseReifyBytesW8 (ns :: [Natural]) where-    parseReifyBytesW8 :: ParserT st e ()+class ParseReifyBytesW8 (idx :: Natural) (bs :: [Natural]) where+    parseReifyBytesW8 :: (Int -> Word8 -> e) -> ParserT st e () --- | Reify the next byte.+-- | Parse the next byte. instance-  ( ReifyW8 n1-  , ParseReifyBytesW8 ns-  ) => ParseReifyBytesW8 (n1 ': ns) where+  ( ReifyW8 b0+  , KnownNat idx+  , ParseReifyBytesW8 (idx+1) bs+  ) => ParseReifyBytesW8 idx (b0 ': bs) where     {-# INLINE parseReifyBytesW8 #-}-    parseReifyBytesW8 = withLit 1# (reifyW8 @n1)-        prim (parseReifyBytesW8 @ns)+    parseReifyBytesW8 f = ParserT $ \fpc base# os# st ->+        let bExpect = reifyW8 @b0+            bActual = indexWord8OffAddrAs# base# os#+            idx     = natValInt @idx+        in  if   bExpect == bActual+            then runParserT# (parseReifyBytesW8 @(idx+1) @bs f) fpc base# (os# +# 1#) st+            else Err# st (f idx bActual)  -- | End of the line.-instance ParseReifyBytesW8 '[] where+instance ParseReifyBytesW8 idx '[] where     {-# INLINE parseReifyBytesW8 #-}-    parseReifyBytesW8 = constParse ()+    parseReifyBytesW8 _f = ParserT $ \_fpc _base# _os# st -> OK# st ()++parseReifyBytesHelper+    :: forall (idx :: Natural) (len :: Natural) a e st+    .  (KnownNat idx, KnownNat len, Integral a, FiniteBits a)+    => a -> (Addr# -> Int# -> a)+    -> ((Int -> Word8 -> e) -> ParserT st e ())+    -> (Int -> Word8 -> e) -> ParserT st e ()+parseReifyBytesHelper a indexWord8OffAddrAsA# pCont f = withLitErr+    (\idx b -> f (natValInt @idx + idx) (fromIntegral b))+    len# a indexWord8OffAddrAsA# (pCont f)+  where+    !(I# len#) = natValInt @len

@@ -1,11 +1,10 @@-{-# LANGUAGE CPP #-} -- for a bytestring version gate >:( {-# LANGUAGE UnboxedTuples #-}  -- may as well export everything the interface is highly unsafe module Bytezap.Poke where  import GHC.Exts-import Raehik.Compat.GHC.Exts.GHC908MemcpyPrimops+import Raehik.Compat.GHC.Exts.GHC908MemcpyPrimops qualified as MemcpyPrimops  import GHC.Word ( Word8(W8#) ) @@ -22,16 +21,45 @@  import Bytezap.Struct qualified as Struct -type Poke# s = Addr# -> Int# -> State# s -> (# State# s, Int# #)+{- | Unboxed buffer write operation. +The next offset must be greater than or equal to the input buffer offset.+This is not checked.++Note that the only way to find out the length of a write is to perform it. But+you can't perform a length without providing a correctly-sized buffer. Thus, you+may only use a 'Poke#' when you have a buffer large enough to fit its maximum+write length-- which in turn means means you must track write lengths+separately. ('Bytezap.Write.Write' does this.)++I provide this highly unsafe, seemingly unhelpful type because it's a+requirement for 'Bytezap.Write.Write', and here I can guarantee performance+better because I don't need to worry about laziness.++We cannot be polymorphic on the pointer type unless we box the pointer.+We thus limit ourselves to writing to 'Addr#'s, and not 'MutableByteArray#'s.+(I figure we're most interested in @ByteString@s, which use 'Addr#'.)++Note that if we did provide write length, then the next offset might appear+superfluous. But that next offset is usually already calculated, and may be+passed directly to sequenced writes, unlike if we returned a write length which+would need to be added to the original offset.+-}+type Poke# s =+     Addr#                {- ^ buffer pointer -}+  -> Int#                 {- ^ buffer offset -}+  -> State# s             {- ^ state token -}+  -> (# State# s, Int# #) {- ^ (state token, next offset) -}+ -- | Poke newtype wrapper. newtype Poke s = Poke { unPoke :: Poke# s } --- | Sequence two 'Poke's left-to-right.+-- | Sequence two buffer writes left-to-right. instance Semigroup (Poke s) where     Poke l <> Poke r = Poke $ \base# os0# s0 ->         case l base# os0# s0 of (# s1, os1# #) -> r base# os1# s1 +-- | The empty buffer write simply returns its state token and offset. instance Monoid (Poke s) where     mempty = Poke $ \_base# os# s -> (# s, os# #) @@ -68,7 +96,7 @@ byteString :: BS.ByteString -> Poke RealWorld byteString (BS.BS (ForeignPtr p# r) (I# len#)) = Poke $ \base# os# s0 ->     keepAlive# r s0 $ \s1 ->-        case copyAddrToAddrNonOverlapping# p# (base# `plusAddr#` os#) len# s1 of+        case MemcpyPrimops.copyAddrToAddrNonOverlapping# p# (base# `plusAddr#` os#) len# s1 of           s2 -> (# s2, os# +# len# #)  byteArray# :: ByteArray# -> Int# -> Int# -> Poke s@@ -79,7 +107,7 @@ -- | essentially memset replicateByte :: Int -> Word8 -> Poke RealWorld replicateByte (I# len#) (W8# byte#) = Poke $ \base# os# s0 ->-    case setAddrRange# (base# `plusAddr#` os#) len# byteAsInt# s0 of+    case MemcpyPrimops.setAddrRange# (base# `plusAddr#` os#) len# byteAsInt# s0 of       s1 -> (# s1, os# +# len# #)   where     byteAsInt# = word2Int# (word8ToWord# byte#)

@@ -0,0 +1,153 @@+{-# LANGUAGE UnboxedTuples #-}++{- | Low-level bytestring builder using continuation parsing.++bytezap's builder is highly performant. However, one thing it can't do is+/fail/. We have no way to flag an error. If you force it, you will either++* write an initial assert, followed by an unsafe builder that relies on it, or+* build a builder as we assert, then execute it once we're ready++The former is inefficient in situations where the check scales similarly with+the build (e.g. both must iterate over the input). And the latter is very silly+since your builder will be allocating all over.++A naive failable builder might use @'Either' e 'Int'@ to flag errors. After+executing, we check the result: if 'Right', we resize to the given actual+length; if 'Left', we discard the buffer with the given error. This is fine...+but it's an extra allocation, and limits us to 'Either'. A shame.++Instead, we design a builder that takes a finalizer continuation @'Int#' ->+'ByteString'@, which is passed the final offset. The builder calls this as it+finishes, wrapping it as needed (or leaving as 'ByteString' for a non-failable+builder). The runner is expected to pass a continuation to perform any buffer+reallocation necessary (if the actual length was less than the max length), and+return a 'ByteString', possibly wrapped in e.g. 'Right'.++This is much harder to use than the regular builder, and they can't be combined+(the regular builder permits sequencing, which this can't support). But it fills+a gap!++Unlike the regular builder we stick with 'IO', because the continuations get+weird otherwise.+-}++module Bytezap.PokeCPS where++import GHC.Exts ( Int#, Addr#, Ptr )++import Data.Text.Internal ( Text(Text) )+import Data.Text.Array qualified as Text+import Data.Word ( Word8 )+import Data.ByteString ( ByteString )+import Data.Primitive.ByteArray ( ByteArray(ByteArray), indexByteArray )+import GHC.Storable ( writeWord8OffPtr )+import Tmp.BSExt qualified as B++type PokeCPS# r = Addr# -> Int# -> (Int# -> IO ByteString) -> IO r++-- | 'PokeCPS#' newtype wrapper.+--+-- Does not permit a 'Semigroup' instance because pokes do not return offset+-- information.+newtype PokeCPS r = PokeCPS { unPokeCPS:: PokeCPS# r }++emptyPokeCPS :: PokeCPS ByteString+emptyPokeCPS = PokeCPS $ \_base# os# finalize -> finalize os#++{- Any unexplained stuff is probably parsing parts of hex bytestrings+Like @xx AA 1a2F@.+-}++{- 2024-08-27 raehik+The best algorithm would probably operate on words (let's assume 8 bytes).+It would involve a shitload of inlining and praying that GHC figures out how to+turn it all into efficient JMPs.+-}++{-+Parse hex bytestring.++Expects that the output buffer can fit the maximum length of the input.++This is a bit overly parametric in the hopes of using it with manual buffering+(e.g. allocate a single buffer and reuse it for every parse). But that's more+complex: we need to carefully set @bufInMax@ so that it also corresponds to the+output buffer as well. But now, we also need to track the input buffer+position... yeah, it's a mess.++Wait, we _are_ tracking input buffer position. We're just not passing it to the+continuation. More reworking, sigh...+-}+full+    :: ByteArray -> Ptr Word8+    -> (Int -> IO r) -> (Word8 -> IO r)+    -> (Word8 -> IO r)+    -> Int -> Int -> Int+    -> IO r+full bufIn bufOut fCont fErrEof fErrNotHexDigit bufInMax = go+  where+    -- each loop writes a single byte or fails+    go = \bufInOs bufOutOs -> do+        let bufInRemaining = bufInMax - bufInOs+        if   bufInRemaining >= 2+        then case indexByteArray @Word8 bufIn bufInOs of+               0x20 -> -- next byte is space+                case indexByteArray @Word8 bufIn (bufInOs+1) of+                  0x20 -> -- and the byte after that: skip both+                    go (bufInOs+2) bufOutOs+                  d1   ->+                    -- next byte is space, then non-space+                    -- could just skip one, but we've already asserted 2 bytes+                    -- so let's copy-paste for just 1 more byte+                    if   bufInRemaining >= 3+                    then do let d0 = indexByteArray @Word8 bufIn (bufInOs+2)+                            withHexNibbles fErrNotHexDigit d1 d0 $ \b -> do+                                writeWord8OffPtr bufOut bufOutOs b+                                go (bufInOs+3) (bufOutOs+1)+                    else fErrEof d1+               d1   -> do+                let d0 = indexByteArray @Word8 bufIn (bufInOs+1)+                withHexNibbles fErrNotHexDigit d1 d0 $ \b -> do+                    writeWord8OffPtr bufOut bufOutOs b+                    go (bufInOs+2) (bufOutOs+1)+        else if   bufInRemaining == 0+             then fCont bufOutOs+             else -- 1 byte remaining+                  case indexByteArray @Word8 bufIn bufInOs of+                    0x20 -> fCont bufOutOs+                    d1   -> fErrEof d1+{-# INLINE full #-}++withHexNibbles ::+    (Word8 -> r) -> Word8 -> Word8 -> (Word8 -> r) -> r+withHexNibbles fFail d1 d0 fCont =+    withByteAsHexDigit d1 fFail $ \n1 ->+        withByteAsHexDigit d0 fFail $ \n0 ->+            fCont $ 0x10*n1 + n0+{-# INLINE withHexNibbles #-}++withByteAsHexDigit :: Word8 -> (Word8 -> r) -> (Word8 -> r) -> r+withByteAsHexDigit c fFail f+  | dec  <= 9 = f dec+  | hexl <= 5 = f $ hexl + 10+  | hexu <= 5 = f $ hexu + 10+  | otherwise = fFail c+  where+    dec   = c - ord_0+    hexl  = c - ord_a+    hexu  = c - ord_A+    ord_0 = 0x30+    ord_a = 0x61+    ord_A = 0x41+{-# INLINE withByteAsHexDigit #-}++textToByteStringUptoIO :: Text -> IO (Either String ByteString)+textToByteStringUptoIO = \(Text (Text.ByteArray tarr) tos tlen) ->+    B.createCPS (tlen `quot` 2) finalizer $ \finalize buf ->+        full (ByteArray tarr) buf finalize fErrEof fErrNotHexDigit tlen tos 0+  where+    fErrNotHexDigit = \b -> pure $ Left ("not a hexadecimal digit: " <> show b)+    finalizer = \fp len -> Right <$> B.mkDeferredByteString fp len+    fErrEof = \_ -> pure $ Left "ended during byte (TODO)"+{-# INLINE textToByteStringUptoIO #-}

@@ -23,7 +23,7 @@ module Bytezap.Struct where  import GHC.Exts-import Raehik.Compat.GHC.Exts.GHC908MemcpyPrimops ( setAddrRange# )+import Raehik.Compat.GHC.Exts.GHC908MemcpyPrimops qualified as GHCExtsCompat import Raehik.Compat.Data.Primitive.Types  import Control.Monad.Primitive ( MonadPrim, primitive )@@ -78,6 +78,6 @@ -- | essentially memset replicateByte :: Int -> Word8 -> Poke RealWorld replicateByte (I# len#) (W8# byte#) = Poke $ \base# os# s0 ->-    setAddrRange# (base# `plusAddr#` os#) len# byteAsInt# s0+    GHCExtsCompat.setAddrRange# (base# `plusAddr#` os#) len# byteAsInt# s0   where     byteAsInt# = word2Int# (word8ToWord# byte#)

@@ -1,13 +1,6 @@-{- | Efficient type-level bytestring serialization.--@['Natural']@s have a convenient syntax, and we can use them as a type-level-bytestring by asserting that each 'Natural' is <=255 when reifying. This module-provides type classes which give you a serializer for a given @['Natural']@.+{-# LANGUAGE AllowAmbiguousTypes, UndecidableInstances #-} -We maximize efficiency by grouping bytes into machine words. We have to be-pretty verbose to achieve this. Each type class attempts to group bytes into its-machine word type, and if it can't (i.e. not enough bytes remain), it hands off-to the next type class which handles the next smaller machine word.+{- | Efficient type-level bytestring serialization via chunking.  I did a quick Core check and found that GHC seems to successfully generate minimal code for this e.g. for an 8-byte magic, GHC will do one@@ -19,87 +12,107 @@ compile time. So I'm fairly confident that this is the best you're gonna get. -} -{-# LANGUAGE AllowAmbiguousTypes, UndecidableInstances #-}+module Bytezap.Struct.TypeLits.Bytes+  (+  -- * Chunking design+  -- $chunking-design -module Bytezap.Struct.TypeLits.Bytes where+    ReifyBytesW64(reifyBytesW64)+  , ReifyBytesW32(reifyBytesW32)+  , ReifyBytesW16(reifyBytesW16)+  , ReifyBytesW8(reifyBytesW8)+  ) where  import Data.Type.Byte import Bytezap.Struct ( Poke, sequencePokes, emptyPoke, prim ) import Numeric.Natural ( Natural ) +{- $chunking-design+@['Natural']@s have a convenient syntax, and we can use them as a type-level+bytestring by asserting that each 'Natural' is <=255 when reifying. This module+provides type classes which give you a serializer for a given @['Natural']@.++We maximize efficiency by grouping bytes into machine words. We have to be+pretty verbose to achieve this. Each type class attempts to group bytes into its+machine word type, and if it can't (i.e. not enough bytes remain), it hands off+to the next type class which handles the next smaller machine word.++TODO rewrite :)+-}+ -- | Serialize a type-level bytestring, largest grouping 'Word64'.-class ReifyBytesW64 (ns :: [Natural]) where reifyBytesW64 :: Poke s+class ReifyBytesW64 (bs :: [Natural]) where reifyBytesW64 :: Poke s  -- | Enough bytes to make a 'Word64'. instance {-# OVERLAPPING #-}-  ( ReifyW8 n1-  , ReifyW8 n2-  , ReifyW8 n3-  , ReifyW8 n4-  , ReifyW8 n5-  , ReifyW8 n6-  , ReifyW8 n7-  , ReifyW8 n8-  , ReifyBytesW64 ns-  ) => ReifyBytesW64 (n1 ': n2 ': n3 ': n4 ': n5 ': n6 ': n7 ': n8 ': ns) where+  ( ReifyW8 b0+  , ReifyW8 b1+  , ReifyW8 b2+  , ReifyW8 b3+  , ReifyW8 b4+  , ReifyW8 b5+  , ReifyW8 b6+  , ReifyW8 b7+  , ReifyBytesW64 bs+  ) => ReifyBytesW64 (b0 ': b1 ': b2 ': b3 ': b4 ': b5 ': b6 ': b7 ': bs) where     {-# INLINE reifyBytesW64 #-}     reifyBytesW64 = sequencePokes-        (prim (reifyW64 @n1 @n2 @n3 @n4 @n5 @n6 @n7 @n8)) 8 (reifyBytesW64 @ns)+        (prim (reifyW64 @b0 @b1 @b2 @b3 @b4 @b5 @b6 @b7)) 8 (reifyBytesW64 @bs)  -- | Try to group 'Word32's next.-instance ReifyBytesW32 ns => ReifyBytesW64 ns where+instance ReifyBytesW32 bs => ReifyBytesW64 bs where     {-# INLINE reifyBytesW64 #-}-    reifyBytesW64 = reifyBytesW32 @ns+    reifyBytesW64 = reifyBytesW32 @bs  -- | Serialize a type-level bytestring, largest grouping 'Word32'.-class ReifyBytesW32 (ns :: [Natural]) where reifyBytesW32 :: Poke s+class ReifyBytesW32 (bs :: [Natural]) where reifyBytesW32 :: Poke s  -- | Enough bytes to make a 'Word32'. instance {-# OVERLAPPING #-}-  ( ReifyW8 n1-  , ReifyW8 n2-  , ReifyW8 n3-  , ReifyW8 n4-  , ReifyBytesW32 ns-  ) => ReifyBytesW32 (n1 ': n2 ': n3 ': n4 ': ns) where+  ( ReifyW8 b0+  , ReifyW8 b1+  , ReifyW8 b2+  , ReifyW8 b3+  , ReifyBytesW32 bs+  ) => ReifyBytesW32 (b0 ': b1 ': b2 ': b3 ': bs) where     {-# INLINE reifyBytesW32 #-}     reifyBytesW32 = sequencePokes-        (prim (reifyW32 @n1 @n2 @n3 @n4)) 4 (reifyBytesW32 @ns)+        (prim (reifyW32 @b0 @b1 @b2 @b3)) 4 (reifyBytesW32 @bs)  -- | Try to group 'Word16's next.-instance ReifyBytesW16 ns => ReifyBytesW32 ns where+instance ReifyBytesW16 bs => ReifyBytesW32 bs where     {-# INLINE reifyBytesW32 #-}-    reifyBytesW32 = reifyBytesW16 @ns+    reifyBytesW32 = reifyBytesW16 @bs  -- | Serialize a type-level bytestring, largest grouping 'Word16'.-class ReifyBytesW16 (ns :: [Natural]) where reifyBytesW16 :: Poke s+class ReifyBytesW16 (bs :: [Natural]) where reifyBytesW16 :: Poke s  -- | Enough bytes to make a 'Word16'. instance {-# OVERLAPPING #-}-  ( ReifyW8 n1-  , ReifyW8 n2-  , ReifyBytesW16 ns-  ) => ReifyBytesW16 (n1 ': n2 ': ns) where+  ( ReifyW8 b0+  , ReifyW8 b1+  , ReifyBytesW16 bs+  ) => ReifyBytesW16 (b0 ': b1 ': bs) where     {-# INLINE reifyBytesW16 #-}     reifyBytesW16 = sequencePokes-        (prim (reifyW16 @n1 @n2)) 2 (reifyBytesW16 @ns)+        (prim (reifyW16 @b0 @b1)) 2 (reifyBytesW16 @bs)  -- | Reify byte-by-byte next.-instance ReifyBytesW8 ns => ReifyBytesW16 ns where+instance ReifyBytesW8 bs => ReifyBytesW16 bs where     {-# INLINE reifyBytesW16 #-}-    reifyBytesW16 = reifyBytesW8 @ns+    reifyBytesW16 = reifyBytesW8 @bs  -- | Serialize a type-level bytestring, byte-by-byte.-class ReifyBytesW8 (ns :: [Natural]) where reifyBytesW8 :: Poke s+class ReifyBytesW8 (bs :: [Natural]) where reifyBytesW8 :: Poke s  -- | Reify the next byte. instance-  ( ReifyW8 n1-  , ReifyBytesW8 ns-  ) => ReifyBytesW8 (n1 ': ns) where+  ( ReifyW8 b0+  , ReifyBytesW8 bs+  ) => ReifyBytesW8 (b0 ': bs) where     {-# INLINE reifyBytesW8 #-}     reifyBytesW8 = sequencePokes-        (prim (reifyW8 @n1)) 1 (reifyBytesW8 @ns)+        (prim (reifyW8 @b0)) 1 (reifyBytesW8 @bs)  -- | End of the line. instance ReifyBytesW8 '[] where

@@ -2,41 +2,43 @@  -- safe module, only export the safe bits (no @Write(..)@!!) module Bytezap.Write-  ( Write(size, poke)+  ( Write(writeLength, writeOp)+  , LengthType(ExactLength, MaxLength)   , runWriteBS, runWriteBSUptoN   , prim, byteString, byteArray#, replicateByte   ) where  import Bytezap.Write.Internal -import Bytezap.Poke qualified as P+import Bytezap.Poke qualified as Poke+import Bytezap.Poke ( Poke ) import Raehik.Compat.Data.Primitive.Types import GHC.Exts import Data.ByteString qualified as BS import Data.Word ( Word8 ) -runWriteBS :: Write RealWorld -> BS.ByteString-runWriteBS = runWriteWith P.unsafeRunPokeBS+runWriteBS :: Write ExactLength RealWorld -> BS.ByteString+runWriteBS = runWriteWith Poke.unsafeRunPokeBS -runWriteBSUptoN :: Write RealWorld -> BS.ByteString-runWriteBSUptoN = runWriteWith P.unsafeRunPokeBSUptoN+runWriteBSUptoN :: Write MaxLength RealWorld -> BS.ByteString+runWriteBSUptoN = runWriteWith Poke.unsafeRunPokeBSUptoN  -- | Helper for writing 'Write' runners.-runWriteWith :: forall a s. (Int -> P.Poke s -> a) -> Write s -> a-runWriteWith runPoke (Write size poke) = runPoke size poke+runWriteWith :: forall a s lt. (Int -> Poke s -> a) -> Write lt s -> a+runWriteWith runPoke (Write l p) = runPoke l p -prim :: forall a s. Prim' a => a -> Write s-prim a = Write (sizeOf (undefined :: a)) (P.prim a)+prim :: forall a s. Prim' a => a -> Write ExactLength s+prim a = Write (sizeOf (undefined :: a)) (Poke.prim a) -byteString :: BS.ByteString -> Write RealWorld-byteString bs = Write (BS.length bs) (P.byteString bs)+byteString :: BS.ByteString -> Write ExactLength RealWorld+byteString bs = Write (BS.length bs) (Poke.byteString bs) -byteArray# :: ByteArray# -> Int# -> Int# -> Write s+byteArray# :: ByteArray# -> Int# -> Int# -> Write ExactLength s byteArray# ba# baos# balen# = Write{..}   where-    size = I# balen#-    poke = P.byteArray# ba# baos# balen#+    writeLength = I# balen#+    writeOp     = Poke.byteArray# ba# baos# balen#  -- | essentially memset-replicateByte :: Int -> Word8 -> Write RealWorld-replicateByte len byte = Write len (P.replicateByte len byte)+replicateByte :: Int -> Word8 -> Write ExactLength RealWorld+replicateByte len byte = Write len (Poke.replicateByte len byte)

@@ -1,25 +1,25 @@ module Bytezap.Write.Derived where  import Bytezap.Write.Internal-import Bytezap.Poke.Derived qualified as P+import Bytezap.Poke.Derived qualified as Poke  import Data.ByteString.Short qualified as SBS import Data.Text.Internal qualified as T import Data.Char ( ord )  -- | Write a 'SBS.ShortByteString'.-shortByteString :: SBS.ShortByteString -> Write s-shortByteString sbs = Write (SBS.length sbs) (P.shortByteString sbs)+shortByteString :: SBS.ShortByteString -> Write ExactLength s+shortByteString sbs = Write (SBS.length sbs) (Poke.shortByteString sbs)  -- | Write a 'T.Text'.-text :: T.Text -> Write s-text t@(T.Text _arr _off len) = Write len (P.text t)+text :: T.Text -> Write ExactLength s+text t@(T.Text _arr _off len) = Write len (Poke.text t)  -- | Write a 'Char'. -- -- Adapted from utf8-string.-char :: Char -> Write s-char c = Write (go (ord c)) (P.char c)+char :: Char -> Write ExactLength s+char c = Write (go (ord c)) (Poke.char c)  where   go oc    | oc <= 0x7f       = 1

@@ -1,15 +1,58 @@ module Bytezap.Write.Internal where -import Bytezap.Poke qualified as P+import Bytezap.Poke ( Poke ) --- | A 'Poke' with the associated size it pokes.-data Write s = Write { size :: Int, poke :: P.Poke s }+-- | A 'Poke' buffer write operation with the associated length to be written.+--+-- The length may be either exact or a maximum.+--+-- TODO strictness?+data Write (lt :: LengthType) s = Write+  { writeLength :: Int+  -- ^ Length of the write in bytes.+  --+  -- This is not statically asserted. Any time you construct a 'Write', you must+  -- promise this.+  --+  -- For @'Write' 'ExactLength' s@, this is an exact measurement.+  -- For @'Write' 'MaxLength'   s@, this is a maximum. --- | Sequence the 'Poke's, sum the sizes.-instance Semigroup (Write s) where-    -- TODO feels like this might be INLINE[1] or even INLINE[0]?-    Write ll lp <> Write rl rp = Write (ll + rl) (lp <> rp)+  , writeOp :: Poke s+  -- ^ The 'Poke' buffer write operation.+  } +-- | What a buffer write length field means.+data LengthType+  = ExactLength -- ^ Exact length to be written.+  | MaxLength   -- ^ Maximum length to be written.++-- | Sequence the writes, sum the lengths.+instance Semigroup (Write lt s) where+    -- TODO strictness? INLINE[1]? INLINE[0]?+    (<>) = writeCombine+ -- | The empty 'Write' is the empty 'Poke', which writes zero bytes.-instance Monoid (Write s) where+instance Monoid (Write lt s) where     mempty = Write 0 mempty++-- | Turn a @'Write' 'ExactLength'@ into a @'Write' 'MaxLength'@.+writeMax :: Write ExactLength s -> Write MaxLength s+writeMax (Write l p) = Write l p++-- | Sequence a @'Write' 'MaxLength'@ and a @'Write' 'ExactLength'@+--   left-to-right.+writeMaxExact :: Write MaxLength s -> Write ExactLength s -> Write MaxLength s+writeMaxExact = writeCombine++-- | Sequence a @'Write' 'MaxLength'@ and a @'Write' 'ExactLength'@+--   left-to-right.+writeExactMax :: Write ExactLength s -> Write MaxLength s -> Write MaxLength s+writeExactMax = writeCombine++-- | Sequence two 'Write's left-to-right.+--+-- Unsafe, as it ignores 'LengthType's.+--+-- TODO strictness? INLINE[1]? INLINE[0]?+writeCombine :: Write ltl s -> Write ltr s -> Write lt s+writeCombine (Write ll lp) (Write rl rp) = Write (ll + rl) (lp <> rp)

@@ -0,0 +1,168 @@+{-# LANGUAGE UnboxedTuples #-}++-- | raehik's bytestring extras (reimplementations of unexported internals).++module Tmp.BSExt+  ( module Tmp.BSExt+  , B.mkDeferredByteString+  ) where++import GHC.ForeignPtr ( ForeignPtr, unsafeWithForeignPtr, withForeignPtr )+import Foreign.Ptr ( Ptr )+import Foreign.Marshal.Utils ( copyBytes )+import Data.ByteString.Internal qualified as B+import Data.ByteString ( ByteString )+import Data.Word ( Word8 )+import Control.Exception ( assert )+import GHC.IO ( IO(IO) )+import GHC.Exts ( runRW# )++-- | Copy the given number of bytes from the second area (source) into the first+--   (destination); the copied areas may not overlap.+--+-- Reimplemented from the unexported function+-- 'Data.ByteString.Internal.Type.memcpyFp'.+memcpyFp :: ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()+memcpyFp fp fq s = unsafeWithForeignPtr fp $ \p ->+                     unsafeWithForeignPtr fq $ \q -> copyBytes p q s++-- | Create a 'ByteString' of size @l@ and use action @f@ to fill its contents.+--+-- Reimplemented from the unexported function+-- 'Data.ByteString.Internal.Type.createFp.+createFp :: Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString+createFp len action = assert (len >= 0) $ do+    fp <- B.mallocByteString len+    action fp+    B.mkDeferredByteString fp len+{-# INLINE createFp #-}++createUptoNCPS+    :: Int+    -> (Ptr Word8 -> (Int -> IO ByteString) -> IO r)+    -> IO r+createUptoNCPS maxLen action = assert (maxLen >= 0) $ do+    fp <- B.mallocByteString maxLen+    withForeignPtr fp $ \p -> action p $ \len ->+        B.mkDeferredByteString fp len+{-# INLINE createUptoNCPS #-}++createCPS+    :: Int+    -> (ForeignPtr Word8 -> Int -> IO r)+    -> ((Int -> IO r) -> Ptr Word8 -> IO r)+    -> IO r+createCPS maxLen finalize f = assert (maxLen >= 0) $ do+    fp <- B.mallocByteString maxLen+    withForeignPtr fp $ \buf -> f (finalize fp) buf+{-# INLINE createCPS #-}++{-+withBuffer+    :: Int+    -> (Ptr Word8 -> Int -> IO r)+    -> (r ->+withBuffer bufLen+{-# INLINE withBuffer #-}+-}++createAndTrimCPS+    :: Int+    -> (Ptr Word8 -> (Int -> IO ByteString) -> IO r)+    -> IO r+createAndTrimCPS maxLen action = assert (maxLen >= 0) $ do+    fp <- B.mallocByteString maxLen+    withForeignPtr fp $ \p -> action p $ \len ->+        if   len < maxLen+        then createFp len (\fp' -> memcpyFp fp' fp len)+             -- ^ apparently @fp@ will get GCed automatically, up to GHC+        else B.mkDeferredByteString fp maxLen+{-# INLINE createAndTrimCPS #-}++unsafeCreateAndTrimCPS+    :: Int+    -> (Ptr Word8 -> (Int -> IO ByteString) -> IO r)+    -> r+unsafeCreateAndTrimCPS l f =+    unsafeDupablePerformIOByteString (createAndTrimCPS l f)+{-# INLINE unsafeCreateAndTrimCPS #-}++createAndTrimFailable+    :: Int+    -> (Ptr Word8 -> IO (Either e Int))+    -> IO (Either e ByteString)+createAndTrimFailable l action = createFpAndTrimFailable l (wrapAction action)+{-# INLINE createAndTrimFailable #-}++-- TODO how do I omit the Either allocation?+createFpAndTrimFailable+    :: Int+    -> (ForeignPtr Word8 -> IO (Either e Int))+    -> IO (Either e ByteString)+createFpAndTrimFailable maxLen action = assert (maxLen >= 0) $ do+    fp <- B.mallocByteString maxLen+    action fp >>= \case+      Right len ->+        if   len < maxLen+        then Right <$> createFp len (\fp' -> memcpyFp fp' fp len)+             -- ^ apparently @fp@ will get GCed automatically, up to GHC+        else Right <$> B.mkDeferredByteString fp maxLen+      Left  err -> pure $ Left err+{-# INLINE createFpAndTrimFailable #-}++createUptoNFailable+    :: Int+    -> (Ptr Word8 -> IO (Either e Int))+    -> IO (Either e ByteString)+createUptoNFailable l action = createFpUptoNFailable l (wrapAction action)+{-# INLINE createUptoNFailable #-}++createFpUptoNFailable+    :: Int+    -> (ForeignPtr Word8 -> IO (Either e Int))+    -> IO (Either e ByteString)+createFpUptoNFailable maxLen action = assert (maxLen >= 0) $ do+    fp <- B.mallocByteString maxLen+    action fp >>= \case+      Right len -> Right <$> B.mkDeferredByteString fp len+      Left  err -> pure $ Left err+{-# INLINE createFpUptoNFailable #-}++createFailable+    :: Int+    -> (Ptr Word8 -> IO (Either e Int))+    -> IO (Either e ByteString)+createFailable l action = createFpFailable l (wrapAction action)+{-# INLINE createFailable #-}++-- TODO how do I omit the Either allocation?+createFpFailable+    :: Int+    -> (ForeignPtr Word8 -> IO (Either e Int))+    -> IO (Either e ByteString)+createFpFailable maxLen action = assert (maxLen >= 0) $ do+    fp <- B.mallocByteString maxLen+    action fp >>= \case+      Right len ->+        -- TODO does not check for correctness (len <= maxLen)!! don't lie!!!!+        Right <$> B.mkDeferredByteString fp len+      Left  err -> pure $ Left err+{-# INLINE createFpFailable #-}++-- TODO probably don't export+wrapAction :: (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res+wrapAction = flip withForeignPtr+  -- Cannot use unsafeWithForeignPtr, because action can diverge++unsafeDupablePerformIOByteString :: IO a -> a+-- Why does this exist? In base-4.15.1.0 until at least base-4.18.0.0,+-- the version of unsafeDupablePerformIO in base prevents unboxing of+-- its results with an opaque call to GHC.Exts.lazy, for reasons described+-- in Note [unsafePerformIO and strictness] in GHC.IO.Unsafe. (See+-- https://hackage.haskell.org/package/base-4.18.0.0/docs/src/GHC.IO.Unsafe.html#line-30 .)+-- Even if we accept the (very questionable) premise that the sort of+-- function described in that note should work, we expect no such+-- calls to be made in the context of bytestring.  (And we really want+-- unboxing!)+unsafeDupablePerformIOByteString (IO act) =+    case runRW# act of (# _, res #) -> res