packages feed

bytezap (empty) → 1.0.0

raw patch · 21 files changed

+985/−0 lines, 21 filesdep +basedep +bytestringdep +primitivesetup-changed

Dependencies added: base, bytestring, primitive, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,2 @@+## 1.0.0 (2024-03-17)+* initial release, finally its own package
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2022-2024 Ben Orchard (@raehik) <thefirstmuffinman@gmail.com>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,51 @@+# bytezap+Build strict bytestrings with zero intermediate allocation.++If you're looking for general high-performance serialization, you probably want+[mason](https://hackage.haskell.org/package/mason). But if you're dealing with+data that is already "shaped" like binary data, e.g. using types defined in+[binrep](https://hackage.haskell.org/package/binrep), and you want the best+performance possible, read on...++## Why?+Most binary serialization libraries tend towards a model where the serializer+itself handles allocation. In the plumbing, serialization operations are+bracketed by a check to ensure the current buffer has enough space for the next+operation; if not, we obtain more space in some way, and serialization+continues. This design is nice because we can _chunk_ the serializing:++* for writing to a lazy bytestring, we can emit a new chunk and clear our buffer+* for writing to a handle, we can write, flush and clear our buffer+* for writing to a strict bytestring, we must grow our current buffer (meh)++But if we know the size of the serialized data _before_ serializing it, we don't+need those space checks, nor these intermediate steps. We may allocate a single+buffer with the required size upfront, then use that as we like.++Great, you say, but most data isn't so simple that we can easily calculate its+serialized length without actually performing the serialization. This is true.+bytezap is designed specifically for cases where++* it's easy to calculate the serialized length of your data, and+* you want to write to a strict bytestring (one big contiguous block of memory)++This last point notably may limit usage for serializing large data, depending on+memory limitations. In most cases, we'll use more memory than a buffering+library such as mason.++## So... why?+Well, bytezap will be slightly faster where it's applicable, and the+implementation is extremely simple. It's a fun niche to fill, and it's+convenient for my [binrep](https://hackage.haskell.org/package/binrep) library.++## Non-features+### Serialize to `ByteString` (pinned byte arrays) only+No `ShortByteString`s, no writing directly to handles.++(One _may_ support writing to `ShortByteString`s (unpinned byte arrays) by doing+a bunch of class indirection. But it's a lot of extra work for a use case that I+don't see as very popular at all. Check the Git history for an early+implementation.)++## License+Provided under the MIT license. See `LICENSE` for license text.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bytezap.cabal view
@@ -0,0 +1,68 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name:           bytezap+version:        1.0.0+synopsis:       Bytestring builder with zero intermediate allocation+description:    Please see README.md.+category:       Data, Serialization+homepage:       https://github.com/raehik/bytezap#readme+bug-reports:    https://github.com/raehik/bytezap/issues+author:         Ben Orchard+maintainer:     Ben Orchard <thefirstmuffinman@gmail.com>+license:        MIT+license-file:   LICENSE+build-type:     Simple+tested-with:+    GHC == 9.6.4+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/raehik/bytezap++library+  exposed-modules:+      Bytezap+      Bytezap.Poke+      Bytezap.Poke.Derived+      Bytezap.Poke.Derived.Endian+      Bytezap.Poke.Json+      Bytezap.Poke.KnownLen+      Bytezap.Write+      Bytezap.Write.Derived+      Bytezap.Write.Internal+      Raehik.Compat.Data.Int.ByteSwap+      Raehik.Compat.Data.Primitive.Types+      Raehik.Compat.Data.Primitive.Types.Endian+      Raehik.Compat.Data.Word.ByteSwap+      Raehik.Compat.GHC.Exts.GHC908MemcpyPrimops+      Raehik.Compat.GHC.Exts.GHC910UnalignedAddrPrimops+      Util.TypeNats+  other-modules:+      Paths_bytezap+  hs-source-dirs:+      src+  default-extensions:+      LambdaCase+      NoStarIsType+      DerivingVia+      DeriveAnyClass+      GADTs+      RoleAnnotations+      DefaultSignatures+      TypeFamilies+      DataKinds+      MagicHash+  ghc-options: -Wall+  build-depends:+      base >=4.18.0.0 && <4.20+    , bytestring >=0.11.5.3 && <0.13.0.0+    , primitive >=0.8.0.0 && <0.10.0.0+    , text >=2.0.2 && <2.2+  default-language: GHC2021
+ src/Bytezap.hs view
@@ -0,0 +1,1 @@+module Bytezap where
+ src/Bytezap/Poke.hs view
@@ -0,0 +1,77 @@+{-# 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 GHC.IO+import GHC.Word++import Data.ByteString qualified as BS+import Data.ByteString.Internal qualified as BS++import Control.Monad ( void )++import Raehik.Compat.Data.Primitive.Types++import GHC.ForeignPtr++type Poke# s = Addr# -> Int# -> State# s -> (# State# s, Int# #)++-- | Poke newtype wrapper.+newtype Poke s = Poke { unPoke :: Poke# s }++-- | Sequence two 'Poke's left-to-right.+instance Semigroup (Poke s) where+    Poke l <> Poke r = Poke $ \addr# os0# s0 ->+        case l addr# os0# s0 of (# s1, os1# #) -> r addr# os1# s1++instance Monoid (Poke s) where+    mempty = Poke $ \_addr# os# s -> (# s, os# #)++-- | Execute a 'Poke' at a fresh 'BS.ByteString' of the given length.+unsafeRunPokeBS :: Int -> Poke RealWorld -> BS.ByteString+unsafeRunPokeBS len = BS.unsafeCreate len . wrapIO++wrapIO :: Poke RealWorld -> Ptr Word8 -> IO ()+wrapIO f p = void (wrapIOUptoN f p)++wrapIOUptoN :: Poke RealWorld -> Ptr Word8 -> IO Int+wrapIOUptoN (Poke p) (Ptr addr#) = IO $ \s0 ->+    case p addr# 0# s0 of (# s1, len# #) -> (# s1, I# len# #)++-- | Execute a 'Poke' at a fresh 'BS.ByteString' of the given maximum length.+--   Does not reallocate if final size is less than estimated.+unsafeRunPokeBSUptoN :: Int -> Poke RealWorld -> BS.ByteString+unsafeRunPokeBSUptoN len = BS.unsafeCreateUptoN len . wrapIOUptoN++-- | Poke a type via its 'Prim'' instance.+prim :: forall a s. Prim' a => a -> Poke s+prim a = Poke $ \addr# os# s0 ->+    case writeWord8OffAddrAs# addr# os# a s0 of+      s1 -> (# s1, os# +# sizeOf# (undefined :: a) #)++-- we reimplement withForeignPtr because it's too high level.+-- keepAlive# has the wrong type before GHC 9.10, but it doesn't matter here+-- because copyAddrToAddrNonOverlapping# forces RealWorld.+byteString :: BS.ByteString -> Poke RealWorld+byteString (BS.BS (ForeignPtr p# r) (I# len#)) = Poke $ \addr# os# s0 ->+    keepAlive# r s0 $ \s1 ->+        case copyAddrToAddrNonOverlapping# p# (addr# `plusAddr#` os#) len# s1 of+          s2 -> (# s2, os# +# len# #)++byteArray# :: ByteArray# -> Int# -> Int# -> Poke s+byteArray# ba# baos# balen# = Poke $ \addr# os# s0 ->+    case copyByteArrayToAddr# ba# baos# (addr# `plusAddr#` os#) balen# s0 of+      s1 -> (# s1, os# +# balen# #)++-- | essentially memset+replicateByte :: Int -> Word8 -> Poke RealWorld+replicateByte (I# len#) (W8# byte#) = Poke $ \addr# os# s0 ->+    case setAddrRange# (addr# `plusAddr#` os#) len# byteAsInt# s0 of+      s1 -> (# s1, os# +# len# #)+  where+    byteAsInt# = word2Int# (word8ToWord# byte#)
+ src/Bytezap/Poke/Derived.hs view
@@ -0,0 +1,62 @@+module Bytezap.Poke.Derived where++import Bytezap.Poke++import Data.ByteString.Short qualified as SBS+import Data.Text.Internal qualified as T+--import Data.Array.Byte qualified as A+-- ^ text-2.1 and above+import Data.Text.Array qualified as A+import Data.Word+import GHC.Int+import Data.Char ( ord )+import Data.Bits ( shiftR, (.&.) )+import GHC.Exts ( sizeofByteArray# )++-- | Poke a 'SBS.ShortByteString'.+shortByteString :: SBS.ShortByteString -> Poke s+shortByteString (SBS.SBS ba#) = byteArray# ba# 0# (sizeofByteArray# ba#)++-- | Poke a 'T.Text'.+text :: T.Text -> Poke s+text (T.Text (A.ByteArray ba#) (I# os#) (I# len#)) = byteArray# ba# os# len#++-- | Poke a 'Char'.+--+-- Adapted from utf8-string.+char :: Char -> Poke s+char = go . ord+ where+  w8 :: Word8 -> Poke s+  w8 = prim+  go oc+   | oc <= 0x7f       = w8 $ fromIntegral oc++   | oc <= 0x7ff      =    w8 (fromIntegral (0xc0 + (oc `shiftR` 6)))+                        <> w8 (fromIntegral (0x80 + oc .&. 0x3f))++   | oc <= 0xffff     =    w8 (fromIntegral (0xe0 + (oc `shiftR` 12)))+                        <> w8 (fromIntegral (0x80 + ((oc `shiftR` 6) .&. 0x3f)))+                        <> w8 (fromIntegral (0x80 + oc .&. 0x3f))+   | otherwise        =    w8 (fromIntegral (0xf0 + (oc `shiftR` 18)))+                        <> w8 (fromIntegral (0x80 + ((oc `shiftR` 12) .&. 0x3f)))+                        <> w8 (fromIntegral (0x80 + ((oc `shiftR` 6) .&. 0x3f)))+                        <> w8 (fromIntegral (0x80 + oc .&. 0x3f))++-- v TODO maybe not needed any more thanks to removing Pokeable class+-- | @unsafePokeIndexed pokeAt off n@ performs @n@ indexed pokes starting from+--   @off@.+--+-- Does not check bounds. Largely intended for bytewise pokes where some work+-- needs to be performed for each byte (e.g. escaping text and poking inline).+unsafePokeIndexed :: (Int -> Poke s) -> Int -> Int -> Poke s+-- no tail recursive option since it'd require binding a ptr, which we can't do+-- due to TYPE rr.+-- if you simply expand the monoidal ops here, you get the tail call ver. but+-- like, will GHC be able to do that?+-- hoping INLINE is good enough. but maybe need to check strictness.+unsafePokeIndexed pokeAt off n = go off+  where+    go i | i >= iend = mempty+         | otherwise = pokeAt i <> go (i+1)+    iend = off + n
+ src/Bytezap/Poke/Derived/Endian.hs view
@@ -0,0 +1,44 @@+module Bytezap.Poke.Derived.Endian where++import Bytezap.Poke++import Data.Word+import Data.Int+import Raehik.Compat.Data.Int.ByteSwap+import GHC.ByteOrder ( ByteOrder(BigEndian, LittleEndian), targetByteOrder )++w16le, w16be :: Word16 -> Poke s+w16le = case targetByteOrder of LittleEndian -> prim+                                BigEndian    -> prim . byteSwap16+w16be = case targetByteOrder of LittleEndian -> prim . byteSwap16+                                BigEndian    -> prim++w32le, w32be :: Word32 -> Poke s+w32le = case targetByteOrder of LittleEndian -> prim+                                BigEndian    -> prim . byteSwap32+w32be = case targetByteOrder of LittleEndian -> prim . byteSwap32+                                BigEndian    -> prim++w64le, w64be :: Word64 -> Poke s+w64le = case targetByteOrder of LittleEndian -> prim+                                BigEndian    -> prim . byteSwap64+w64be = case targetByteOrder of LittleEndian -> prim . byteSwap64+                                BigEndian    -> prim++i16le, i16be ::  Int16 -> Poke s+i16le = case targetByteOrder of LittleEndian -> prim+                                BigEndian    -> prim . byteSwapI16+i16be = case targetByteOrder of LittleEndian -> prim . byteSwapI16+                                BigEndian    -> prim++i32le, i32be ::  Int32 -> Poke s+i32le = case targetByteOrder of LittleEndian -> prim+                                BigEndian    -> prim . byteSwapI32+i32be = case targetByteOrder of LittleEndian -> prim . byteSwapI32+                                BigEndian    -> prim++i64le, i64be ::  Int64 -> Poke s+i64le = case targetByteOrder of LittleEndian -> prim+                                BigEndian    -> prim . byteSwapI64+i64be = case targetByteOrder of LittleEndian -> prim . byteSwapI64+                                BigEndian    -> prim
+ src/Bytezap/Poke/Json.hs view
@@ -0,0 +1,64 @@+module Bytezap.Poke.Json where++import Data.Word+import Data.Text.Internal qualified as T+import Data.Text.Array qualified as A++import Bytezap.Poke.Derived ( unsafePokeIndexed )+import Bytezap.Poke++import GHC.Exts+import Foreign.C.Types ( CChar )+import GHC.Word++escapedLength8 :: T.Text -> Int+escapedLength8 (T.Text arr off len) = go off 0+  where+    go !i escLen+      | i >= iend = escLen+      | otherwise = go (i+1) (i + escapeW8 (A.unsafeIndex arr i))+    iend = off + len++-- my benchmarks go much faster without INLINE :/+escapeW8 :: Word8 -> Int+escapeW8 w | w >= 0x80 = 1 -- all multibyte chars are unescaped+           | otherwise = case w of 0x5C -> 2 -- \+                                   0x22 -> 2 -- "+                                   0x0A -> 2 -- \n+                                   0x0D -> 2 -- \r+                                   0x09 -> 2 -- \t+                                   _    -> if w < 0x20 then 6 else 1++pokeEscapedTextUnquoted :: T.Text -> Poke s+pokeEscapedTextUnquoted (T.Text arr off len) =+    unsafePokeIndexed (pokeEscapeW8 . A.unsafeIndex arr) off len++-- think we have to poke bytes here still thanks to endianness >:(+pokeEscapeW8 :: Word8 -> Poke s+pokeEscapeW8 w+  | w >= 0x80 = w8 w -- all multibyte chars are unescaped+  | otherwise =+        case w of+          0x5C -> w8 0x5C <> w8 0x5C -- \+          0x22 -> w8 0x5C <> w8 0x22 -- "+          0x0A -> w8 0x5C <> w8 0x6E -- \n+          0x0D -> w8 0x5C <> w8 0x72 -- \r+          0x09 -> w8 0x5C <> w8 0x74 -- \t+          _    ->+            if w >= 0x20 then w8 w else w8 0x5C <> w8 0x75 <> w8 0x30 <> w8 0x30 <> w8AsciiHex w+  where w8 = prim @Word8++-- note I index because I _think_ this is immutable mem! but I might be wrong+-- and very stupid!!+-- look I'm copying some very weird code from bytestring here. idk+w8AsciiHex :: Word8 -> Poke s+w8AsciiHex w = prim (W16# (indexWord16OffAddr# c_lower_hex_table# wI))+  where+    !(I# wI) = fromIntegral w+    !(Ptr c_lower_hex_table#) = c_lower_hex_table++-- TODO lol I'm saying safe b/c I think it's immutable mem. but I might be+-- making a huge fucky wucky here xd+-- can't do Addr# here, no unlifted top-level values x)+foreign import ccall safe "&hs_bytestring_lower_hex_table"+    c_lower_hex_table :: Ptr CChar
+ src/Bytezap/Poke/KnownLen.hs view
@@ -0,0 +1,28 @@+-- | 'P.Poke's with type-level poke length.+module Bytezap.Poke.KnownLen where++import Bytezap.Poke qualified as P+import GHC.TypeNats+import Data.ByteString qualified as BS+import GHC.Exts+import Util.TypeNats ( natValInt )++import Raehik.Compat.Data.Primitive.Types++newtype PokeKnownLen (len :: Natural) s =+    PokeKnownLen { unPokeKnownLen :: P.Poke s }++mappend' :: PokeKnownLen n s -> PokeKnownLen m s -> PokeKnownLen (n+m) s+mappend' (PokeKnownLen l) (PokeKnownLen r) = PokeKnownLen (l <> r)++mempty' :: PokeKnownLen 0 s+mempty' = PokeKnownLen mempty++runPokeKnownLenBS+    :: forall n. KnownNat n+    => PokeKnownLen n RealWorld+    -> BS.ByteString+runPokeKnownLenBS (PokeKnownLen p) = P.unsafeRunPokeBS (natValInt @n) p++prim :: Prim' a => a -> PokeKnownLen (SizeOf a) s+prim = PokeKnownLen . P.prim
+ src/Bytezap/Write.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE RecordWildCards #-}++-- safe module, only export the safe bits (no @Write(..)@!!)+module Bytezap.Write+  ( Write(size, poke)+  , runWriteBS, runWriteBSUptoN+  , prim, byteString, byteArray#, replicateByte+  ) where++import Bytezap.Write.Internal++import Bytezap.Poke qualified as P+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++runWriteBSUptoN :: Write RealWorld -> BS.ByteString+runWriteBSUptoN = runWriteWith P.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++prim :: forall a s. Prim' a => a -> Write s+prim a = Write (sizeOf (undefined :: a)) (P.prim a)++byteString :: BS.ByteString -> Write RealWorld+byteString bs = Write (BS.length bs) (P.byteString bs)++byteArray# :: ByteArray# -> Int# -> Int# -> Write s+byteArray# ba# baos# balen# = Write{..}+  where+    size = I# balen#+    poke = P.byteArray# ba# baos# balen#++-- | essentially memset+replicateByte :: Int -> Word8 -> Write RealWorld+replicateByte len byte = Write len (P.replicateByte len byte)
+ src/Bytezap/Write/Derived.hs view
@@ -0,0 +1,28 @@+module Bytezap.Write.Derived where++import Bytezap.Write.Internal+import Bytezap.Poke.Derived qualified as P++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)++-- | Write a 'T.Text'.+text :: T.Text -> Write s+text t@(T.Text _arr _off len) = Write len (P.text t)++-- | Write a 'Char'.+--+-- Adapted from utf8-string.+char :: Char -> Write s+char c = Write (go (ord c)) (P.char c)+ where+  go oc+   | oc <= 0x7f       = 1+   | oc <= 0x7ff      = 2+   | oc <= 0xffff     = 3+   | otherwise        = 4
+ src/Bytezap/Write/Internal.hs view
@@ -0,0 +1,15 @@+module Bytezap.Write.Internal where++import Bytezap.Poke qualified as P++-- | A 'Poke' with the associated size it pokes.+data Write s = Write { size :: Int, poke :: P.Poke s }++-- | 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)++-- | The empty 'Write' is the empty 'Poke', which writes zero bytes.+instance Monoid (Write s) where+    mempty = Write 0 mempty
+ src/Raehik/Compat/Data/Int/ByteSwap.hs view
@@ -0,0 +1,26 @@+-- | Missing @byteSwap@ functions for signed integers.+--+-- We have them for unsigned integers, but not for signed.+-- They should probably be provided, so I'm considering this a compatibility+-- module for the future when we have them.++module Raehik.Compat.Data.Int.ByteSwap where++import GHC.Exts+import GHC.Int++byteSwapI16 :: Int16 -> Int16+byteSwapI16 (I16# i#) = I16# (word16ToInt16# (wordToWord16# (byteSwap16# (word16ToWord# (int16ToWord16# i#)))))+{-# INLINE byteSwapI16 #-}++byteSwapI32 :: Int32 -> Int32+byteSwapI32 (I32# i#) = I32# (word32ToInt32# (wordToWord32# (byteSwap32# (word32ToWord# (int32ToWord32# i#)))))+{-# INLINE byteSwapI32 #-}++byteSwapI64 :: Int64 -> Int64+byteSwapI64 (I64# i#) = I64# (word64ToInt64# (byteSwap64# (int64ToWord64# i#)))+{-# INLINE byteSwapI64 #-}++byteSwapI :: Int -> Int+byteSwapI (I# i#) = I# (word2Int# (byteSwap# (int2Word# i#)))+{-# INLINE byteSwapI #-}
+ src/Raehik/Compat/Data/Primitive/Types.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnboxedTuples #-}++#include "MachDeps.h"++module Raehik.Compat.Data.Primitive.Types+  ( Prim'(..)+  , P.Prim(..)+  , P.sizeOf+  ) where++import Data.Primitive.Types qualified as P+import Raehik.Compat.GHC.Exts.GHC910UnalignedAddrPrimops+import GHC.Exts+import GHC.Word+import GHC.Int+import Numeric.Natural++-- | 'P.Prim' extension class providing unaligned accesses+--+-- hoping to get this merged in https://github.com/haskell/primitive/issues/409+--+-- (also includes Addr# primops which that issue/PR may not)+--+-- Also includes an associated type for size in bytes. Another thing that maybe+-- primitive could provide. (Wouldn't be hard!)+class P.Prim a => Prim' a where+    type SizeOf a :: Natural+    -- | Read a value from the array. The offset is in bytes.+    indexWord8ByteArrayAs# :: ByteArray# -> Int# -> a++    readWord8ByteArrayAs#  :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)+    writeWord8ByteArrayAs# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s++    indexWord8OffAddrAs# :: Addr# -> Int# -> a++    readWord8OffAddrAs#  :: Addr# -> Int# -> State# s -> (# State# s, a #)+    writeWord8OffAddrAs# :: Addr# -> Int# -> a -> State# s -> State# s++instance Prim' Word8 where+    type SizeOf Word8 = SIZEOF_WORD8+    indexWord8ByteArrayAs# = P.indexByteArray#+    readWord8ByteArrayAs#  = P.readByteArray#+    writeWord8ByteArrayAs# = P.writeByteArray#+    indexWord8OffAddrAs#   = P.indexOffAddr#+    readWord8OffAddrAs#    = P.readOffAddr#+    writeWord8OffAddrAs#   = P.writeOffAddr#++instance Prim' Word16 where+    type SizeOf Word16 = SIZEOF_WORD16+    indexWord8ByteArrayAs# arr# os# = W16# (indexWord8ArrayAsWord16# arr# os#)+    readWord8ByteArrayAs# arr# os# = \s0 ->+        case readWord8ArrayAsWord16# arr# os# s0 of+          (# s1, w# #) -> (# s1, W16# w# #)+    writeWord8ByteArrayAs# arr# os# (W16# w#) = \s0 ->+        writeWord8ArrayAsWord16# arr# os# w# s0+    indexWord8OffAddrAs# addr# os# = W16# (indexWord8OffAddrAsWord16# addr# os#)+    readWord8OffAddrAs# addr# os# = \s0 ->+        case readWord8OffAddrAsWord16# addr# os# s0 of+          (# s1, w# #) -> (# s1, W16# w# #)+    writeWord8OffAddrAs# addr# os# (W16# w#) s# =+        writeWord8OffAddrAsWord16# addr# os# w# s#++instance Prim' Word32 where+    type SizeOf Word32 = SIZEOF_WORD32+    indexWord8ByteArrayAs# arr# os# = W32# (indexWord8ArrayAsWord32# arr# os#)+    readWord8ByteArrayAs# arr# os# = \s0 ->+        case readWord8ArrayAsWord32# arr# os# s0 of+          (# s1, w# #) -> (# s1, W32# w# #)+    writeWord8ByteArrayAs# arr# os# (W32# w#) = \s0 ->+        writeWord8ArrayAsWord32# arr# os# w# s0+    indexWord8OffAddrAs# addr# os# = W32# (indexWord8OffAddrAsWord32# addr# os#)+    readWord8OffAddrAs# addr# os# = \s0 ->+        case readWord8OffAddrAsWord32# addr# os# s0 of+          (# s1, w# #) -> (# s1, W32# w# #)+    writeWord8OffAddrAs# addr# os# (W32# w#) s# =+        writeWord8OffAddrAsWord32# addr# os# w# s#++instance Prim' Word64 where+    type SizeOf Word64 = SIZEOF_WORD64+    indexWord8ByteArrayAs# arr# os# = W64# (indexWord8ArrayAsWord64# arr# os#)+    readWord8ByteArrayAs# arr# os# = \s0 ->+        case readWord8ArrayAsWord64# arr# os# s0 of+          (# s1, w# #) -> (# s1, W64# w# #)+    writeWord8ByteArrayAs# arr# os# (W64# w#) = \s0 ->+        writeWord8ArrayAsWord64# arr# os# w# s0+    indexWord8OffAddrAs# addr# os# = W64# (indexWord8OffAddrAsWord64# addr# os#)+    readWord8OffAddrAs# addr# os# = \s0 ->+        case readWord8OffAddrAsWord64# addr# os# s0 of+          (# s1, w# #) -> (# s1, W64# w# #)+    writeWord8OffAddrAs# addr# os# (W64# w#) s# =+        writeWord8OffAddrAsWord64# addr# os# w# s#++instance Prim' Int8 where+    type SizeOf Int8 = SIZEOF_INT8+    indexWord8ByteArrayAs# = P.indexByteArray#+    readWord8ByteArrayAs#  = P.readByteArray#+    writeWord8ByteArrayAs# = P.writeByteArray#+    indexWord8OffAddrAs#   = P.indexOffAddr#+    readWord8OffAddrAs#    = P.readOffAddr#+    writeWord8OffAddrAs#   = P.writeOffAddr#++instance Prim' Int16 where+    type SizeOf Int16 = SIZEOF_INT16+    indexWord8ByteArrayAs# arr# os# = I16# (indexWord8ArrayAsInt16# arr# os#)+    readWord8ByteArrayAs# arr# os# = \s0 ->+        case readWord8ArrayAsInt16# arr# os# s0 of+          (# s1, w# #) -> (# s1, I16# w# #)+    writeWord8ByteArrayAs# arr# os# (I16# w#) = \s0 ->+        writeWord8ArrayAsInt16# arr# os# w# s0+    indexWord8OffAddrAs# addr# os# = I16# (indexWord8OffAddrAsInt16# addr# os#)+    readWord8OffAddrAs# addr# os# = \s0 ->+        case readWord8OffAddrAsInt16# addr# os# s0 of+          (# s1, w# #) -> (# s1, I16# w# #)+    writeWord8OffAddrAs# addr# os# (I16# w#) s# =+        writeWord8OffAddrAsInt16# addr# os# w# s#++instance Prim' Int32 where+    type SizeOf Int32 = SIZEOF_INT32+    indexWord8ByteArrayAs# arr# os# = I32# (indexWord8ArrayAsInt32# arr# os#)+    readWord8ByteArrayAs# arr# os# = \s0 ->+        case readWord8ArrayAsInt32# arr# os# s0 of+          (# s1, w# #) -> (# s1, I32# w# #)+    writeWord8ByteArrayAs# arr# os# (I32# w#) = \s0 ->+        writeWord8ArrayAsInt32# arr# os# w# s0+    indexWord8OffAddrAs# addr# os# = I32# (indexWord8OffAddrAsInt32# addr# os#)+    readWord8OffAddrAs# addr# os# = \s0 ->+        case readWord8OffAddrAsInt32# addr# os# s0 of+          (# s1, w# #) -> (# s1, I32# w# #)+    writeWord8OffAddrAs# addr# os# (I32# w#) s# =+        writeWord8OffAddrAsInt32# addr# os# w# s#++instance Prim' Int64 where+    type SizeOf Int64 = SIZEOF_INT64+    indexWord8ByteArrayAs# arr# os# = I64# (indexWord8ArrayAsInt64# arr# os#)+    readWord8ByteArrayAs# arr# os# = \s0 ->+        case readWord8ArrayAsInt64# arr# os# s0 of+          (# s1, w# #) -> (# s1, I64# w# #)+    writeWord8ByteArrayAs# arr# os# (I64# w#) = \s0 ->+        writeWord8ArrayAsInt64# arr# os# w# s0+    indexWord8OffAddrAs# addr# os# = I64# (indexWord8OffAddrAsInt64# addr# os#)+    readWord8OffAddrAs# addr# os# = \s0 ->+        case readWord8OffAddrAsInt64# addr# os# s0 of+          (# s1, w# #) -> (# s1, I64# w# #)+    writeWord8OffAddrAs# addr# os# (I64# w#) s# =+        writeWord8OffAddrAsInt64# addr# os# w# s#++instance Prim' Word where+    type SizeOf Word = SIZEOF_HSWORD+    indexWord8ByteArrayAs# arr# os# = W# (indexWord8ArrayAsWord# arr# os#)+    readWord8ByteArrayAs# arr# os# = \s0 ->+        case readWord8ArrayAsWord# arr# os# s0 of+          (# s1, w# #) -> (# s1, W# w# #)+    writeWord8ByteArrayAs# arr# os# (W# w#) = \s0 ->+        writeWord8ArrayAsWord# arr# os# w# s0+    indexWord8OffAddrAs# addr# os# = W# (indexWord8OffAddrAsWord# addr# os#)+    readWord8OffAddrAs# addr# os# = \s0 ->+        case readWord8OffAddrAsWord# addr# os# s0 of+          (# s1, w# #) -> (# s1, W# w# #)+    writeWord8OffAddrAs# addr# os# (W# w#) s# =+        writeWord8OffAddrAsWord# addr# os# w# s#++instance Prim' Int where+    type SizeOf Int = SIZEOF_HSINT+    indexWord8ByteArrayAs# arr# os# = I# (indexWord8ArrayAsInt# arr# os#)+    readWord8ByteArrayAs# arr# os# = \s0 ->+        case readWord8ArrayAsInt# arr# os# s0 of+          (# s1, w# #) -> (# s1, I# w# #)+    writeWord8ByteArrayAs# arr# os# (I# w#) = \s0 ->+        writeWord8ArrayAsInt# arr# os# w# s0+    indexWord8OffAddrAs# addr# os# = I# (indexWord8OffAddrAsInt# addr# os#)+    readWord8OffAddrAs# addr# os# = \s0 ->+        case readWord8OffAddrAsInt# addr# os# s0 of+          (# s1, w# #) -> (# s1, I# w# #)+    writeWord8OffAddrAs# addr# os# (I# w#) s# =+        writeWord8OffAddrAsInt# addr# os# w# s#
+ src/Raehik/Compat/Data/Primitive/Types/Endian.hs view
@@ -0,0 +1,100 @@+-- | I think this should be in primitive.++{-# LANGUAGE CPP #-}+{-# LANGUAGE UnboxedTuples #-}++module Raehik.Compat.Data.Primitive.Types.Endian where++import Raehik.Compat.Data.Primitive.Types+import               Data.Word+import Raehik.Compat.Data.Word.ByteSwap qualified as X+import               Data.Int+import Raehik.Compat.Data.Int.ByteSwap+import GHC.ByteOrder+import Data.Kind+import GHC.Float++-- | Boxed types which permit reversing byte order ("byte swapping").+class ByteSwap a where byteSwap :: a -> a+instance ByteSwap Word16 where byteSwap = byteSwap16+instance ByteSwap Word32 where byteSwap = byteSwap32+instance ByteSwap Word64 where byteSwap = byteSwap64+instance ByteSwap Word   where byteSwap = X.byteSwap+instance ByteSwap  Int16 where byteSwap = byteSwapI16+instance ByteSwap  Int32 where byteSwap = byteSwapI32+instance ByteSwap  Int64 where byteSwap = byteSwapI64+instance ByteSwap  Int   where byteSwap = byteSwapI++-- I think these two are well-founded. No tests currently though.+instance ByteSwap Float  where+    byteSwap = castWord32ToFloat  . byteSwap . castFloatToWord32+instance ByteSwap Double where+    byteSwap = castWord64ToDouble . byteSwap . castDoubleToWord64++newtype ByteOrdered (end :: ByteOrder) a = ByteOrdered+  { unByteOrdered :: a }+    deriving (Ord, Eq, Show, Num) via a++-- | Newtype for easier instance derivation.+newtype PrimByteSwapped a = PrimByteSwapped { unPrimByteSwapped :: a }++-- | Prim instance where we byte swap at accesses.+instance (Prim a, ByteSwap a) => Prim (PrimByteSwapped a) where+    sizeOf# (PrimByteSwapped a) = sizeOf# a+    alignment# (PrimByteSwapped a) = alignment# a+    indexByteArray# arr# i# =+        PrimByteSwapped (byteSwap (indexByteArray# arr# i#))+    readByteArray# arr# i# = \s0 ->+        case readByteArray# arr# i# s0 of+          (# s1, a #) -> (# s1, PrimByteSwapped (byteSwap a) #)+    writeByteArray# arr# i# (PrimByteSwapped a) = \s0 ->+        writeByteArray# arr# i# (byteSwap a) s0+    setByteArray# arr# i# len# (PrimByteSwapped a) = \s0 ->+        setByteArray# arr# i# len# (byteSwap a) s0+    indexOffAddr# addr# i# =+        PrimByteSwapped (byteSwap (indexOffAddr# addr# i#))+    readOffAddr# addr# i# = \s0 ->+        case readOffAddr# addr# i# s0 of+          (# s1, a #) -> (# s1, PrimByteSwapped (byteSwap a) #)+    writeOffAddr# addr# i# (PrimByteSwapped a) = \s0 ->+        writeOffAddr# addr# i# (byteSwap a) s0+    setOffAddr# arr# i# len# (PrimByteSwapped a) = \s0 ->+        setOffAddr# arr# i# len# (byteSwap a) s0++instance (Prim' a, ByteSwap a) => Prim' (PrimByteSwapped a) where+    type SizeOf (PrimByteSwapped a) = SizeOf a+    indexWord8ByteArrayAs# arr# os# =+        PrimByteSwapped (byteSwap (indexWord8ByteArrayAs# arr# os#))+    readWord8ByteArrayAs# arr# os# = \s0 ->+        case readWord8ByteArrayAs# arr# os# s0 of+          (# s1, a #) -> (# s1, PrimByteSwapped (byteSwap a) #)+    writeWord8ByteArrayAs# arr# os# (PrimByteSwapped a) = \s0 ->+        writeWord8ByteArrayAs# arr# os# (byteSwap a) s0+    indexWord8OffAddrAs# addr# os# =+        PrimByteSwapped (byteSwap (indexWord8OffAddrAs# addr# os#))+    readWord8OffAddrAs# addr# os# = \s0 ->+        case readWord8OffAddrAs# addr# os# s0 of+          (# s1, a #) -> (# s1, PrimByteSwapped (byteSwap a) #)+    writeWord8OffAddrAs# addr# os# (PrimByteSwapped a) = \s0 ->+        writeWord8OffAddrAs# addr# os# (byteSwap a) s0++-- idk why I gotta (a :: Type) why is GHC going kind-polymorphic there lol+#if defined(WORDS_BIGENDIAN)+deriving via (PrimByteSwapped a) instance+    (Prim  a, ByteSwap a) => Prim  (ByteOrdered 'LittleEndian a)+deriving via (PrimByteSwapped a) instance+    (Prim' a, ByteSwap a) => Prim' (ByteOrdered 'LittleEndian a)+deriving via (a :: Type) instance+    Prim  a => Prim  (ByteOrdered 'BigEndian a)+deriving via (a :: Type) instance+    Prim' a => Prim' (ByteOrdered 'BigEndian a)+#else+deriving via (a :: Type) instance+    Prim  a => Prim  (ByteOrdered 'LittleEndian a)+deriving via (a :: Type) instance+    Prim' a => Prim' (ByteOrdered 'LittleEndian a)+deriving via (PrimByteSwapped a) instance+    (Prim  a, ByteSwap a) => Prim  (ByteOrdered 'BigEndian a)+deriving via (PrimByteSwapped a) instance+    (Prim' a, ByteSwap a) => Prim' (ByteOrdered 'BigEndian a)+#endif
+ src/Raehik/Compat/Data/Word/ByteSwap.hs view
@@ -0,0 +1,12 @@+-- | Missing @byteSwap@ functions for unsigned integers.+--+-- Don't know why this one is missing.++module Raehik.Compat.Data.Word.ByteSwap where++import GHC.Exts ( byteSwap# )+import GHC.Word ( Word(W#) )++byteSwap :: Word -> Word+byteSwap (W# i#) = W# (byteSwap# i#)+{-# INLINE byteSwap #-}
+ src/Raehik/Compat/GHC/Exts/GHC908MemcpyPrimops.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE UnboxedTuples #-}++module Raehik.Compat.GHC.Exts.GHC908MemcpyPrimops where++import GHC.Exts+import GHC.IO ( unIO )+import Foreign.Marshal.Utils ( copyBytes, fillBytes )++copyAddrToAddrNonOverlapping#+    :: Addr# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld+copyAddrToAddrNonOverlapping# src# dest# len# s# =+    case unIO (copyBytes (Ptr dest#) (Ptr src#) (fromIntegral (I# len#))) s# of+      (# s'#, () #) -> s'#++setAddrRange#+    :: Addr# -> Int# -> Int# -> State# RealWorld -> State# RealWorld+setAddrRange# dest# w# len# s0 =+    case unIO (fillBytes (Ptr dest#) (fromIntegral (I# w#)) (I# len#)) s0 of+      (# s1, () #) -> s1
+ src/Raehik/Compat/GHC/Exts/GHC910UnalignedAddrPrimops.hs view
@@ -0,0 +1,131 @@+{-+(index|read|write)<ty>OffAddr# primops fail when unaligned on platforms not+supporting unaligned accesses. GHC 9.10 introduces new primops that handle+cases where platforms need aligned accesses. This module imitates that for+older GHCs, but without the safety. So we still fail when unaligned, but it's+easier to upgrade when GHC 9.10 is out.++Note that GC-managed addresses already have these primops. This is for 'Addr#',+non-GC-managed.++Import this module unqualified along with 'GHC.Exts' .+-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE UnboxedTuples #-}++module Raehik.Compat.GHC.Exts.GHC910UnalignedAddrPrimops where++#if MIN_VERSION_base(4,20,0)++-- These should be in base-4.20.0.0.++#else++import GHC.Exts++indexWord8OffAddrAsWord16# :: Addr# -> Int# -> Word16#+indexWord8OffAddrAsWord16# addr# os# =+    indexWord16OffAddr# (addr# `plusAddr#` os#) 0#++readWord8OffAddrAsWord16#+    :: Addr# -> Int# -> State# d -> (# State# d, Word16# #)+readWord8OffAddrAsWord16# addr# os# = \s0 ->+    readWord16OffAddr# (addr# `plusAddr#` os#) 0# s0++writeWord8OffAddrAsWord16# :: Addr# -> Int# -> Word16# -> State# d -> State# d+writeWord8OffAddrAsWord16# addr# os# i# s# =+    writeWord16OffAddr# (addr# `plusAddr#` os#) 0# i# s#++indexWord8OffAddrAsWord32# :: Addr# -> Int# -> Word32#+indexWord8OffAddrAsWord32# addr# os# =+    indexWord32OffAddr# (addr# `plusAddr#` os#) 0#++readWord8OffAddrAsWord32#+    :: Addr# -> Int# -> State# d -> (# State# d, Word32# #)+readWord8OffAddrAsWord32# addr# os# = \s0 ->+    readWord32OffAddr# (addr# `plusAddr#` os#) 0# s0++writeWord8OffAddrAsWord32# :: Addr# -> Int# -> Word32# -> State# d -> State# d+writeWord8OffAddrAsWord32# addr# os# i# s# =+    writeWord32OffAddr# (addr# `plusAddr#` os#) 0# i# s#++indexWord8OffAddrAsWord64# :: Addr# -> Int# -> Word64#+indexWord8OffAddrAsWord64# addr# os# =+    indexWord64OffAddr# (addr# `plusAddr#` os#) 0#++readWord8OffAddrAsWord64#+    :: Addr# -> Int# -> State# d -> (# State# d, Word64# #)+readWord8OffAddrAsWord64# addr# os# = \s0 ->+    readWord64OffAddr# (addr# `plusAddr#` os#) 0# s0++writeWord8OffAddrAsWord64# :: Addr# -> Int# -> Word64# -> State# d -> State# d+writeWord8OffAddrAsWord64# addr# os# i# s# =+    writeWord64OffAddr# (addr# `plusAddr#` os#) 0# i# s#++indexWord8OffAddrAsWord# :: Addr# -> Int# -> Word#+indexWord8OffAddrAsWord# addr# os# =+    indexWordOffAddr# (addr# `plusAddr#` os#) 0#++readWord8OffAddrAsWord#+    :: Addr# -> Int# -> State# d -> (# State# d, Word# #)+readWord8OffAddrAsWord# addr# os# = \s0 ->+    readWordOffAddr# (addr# `plusAddr#` os#) 0# s0++writeWord8OffAddrAsWord# :: Addr# -> Int# -> Word# -> State# d -> State# d+writeWord8OffAddrAsWord# addr# os# i# s# =+    writeWordOffAddr# (addr# `plusAddr#` os#) 0# i# s#++indexWord8OffAddrAsInt16# :: Addr# -> Int# -> Int16#+indexWord8OffAddrAsInt16# addr# os# =+    indexInt16OffAddr# (addr# `plusAddr#` os#) 0#++readWord8OffAddrAsInt16#+    :: Addr# -> Int# -> State# d -> (# State# d, Int16# #)+readWord8OffAddrAsInt16# addr# os# = \s0 ->+    readInt16OffAddr# (addr# `plusAddr#` os#) 0# s0++writeWord8OffAddrAsInt16# :: Addr# -> Int# -> Int16# -> State# d -> State# d+writeWord8OffAddrAsInt16# addr# os# i# s# =+    writeInt16OffAddr# (addr# `plusAddr#` os#) 0# i# s#++indexWord8OffAddrAsInt32# :: Addr# -> Int# -> Int32#+indexWord8OffAddrAsInt32# addr# os# =+    indexInt32OffAddr# (addr# `plusAddr#` os#) 0#++readWord8OffAddrAsInt32#+    :: Addr# -> Int# -> State# d -> (# State# d, Int32# #)+readWord8OffAddrAsInt32# addr# os# = \s0 ->+    readInt32OffAddr# (addr# `plusAddr#` os#) 0# s0++writeWord8OffAddrAsInt32# :: Addr# -> Int# -> Int32# -> State# d -> State# d+writeWord8OffAddrAsInt32# addr# os# i# s# =+    writeInt32OffAddr# (addr# `plusAddr#` os#) 0# i# s#++indexWord8OffAddrAsInt64# :: Addr# -> Int# -> Int64#+indexWord8OffAddrAsInt64# addr# os# =+    indexInt64OffAddr# (addr# `plusAddr#` os#) 0#++readWord8OffAddrAsInt64#+    :: Addr# -> Int# -> State# d -> (# State# d, Int64# #)+readWord8OffAddrAsInt64# addr# os# = \s0 ->+    readInt64OffAddr# (addr# `plusAddr#` os#) 0# s0++writeWord8OffAddrAsInt64# :: Addr# -> Int# -> Int64# -> State# d -> State# d+writeWord8OffAddrAsInt64# addr# os# i# s# =+    writeInt64OffAddr# (addr# `plusAddr#` os#) 0# i# s#++indexWord8OffAddrAsInt# :: Addr# -> Int# -> Int#+indexWord8OffAddrAsInt# addr# os# =+    indexIntOffAddr# (addr# `plusAddr#` os#) 0#++readWord8OffAddrAsInt#+    :: Addr# -> Int# -> State# d -> (# State# d, Int# #)+readWord8OffAddrAsInt# addr# os# = \s0 ->+    readIntOffAddr# (addr# `plusAddr#` os#) 0# s0++writeWord8OffAddrAsInt# :: Addr# -> Int# -> Int# -> State# d -> State# d+writeWord8OffAddrAsInt# addr# os# i# s# =+    writeIntOffAddr# (addr# `plusAddr#` os#) 0# i# s#++#endif
+ src/Util/TypeNats.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Handy typenat utils.++module Util.TypeNats where++-- natVal''+import GHC.TypeNats ( Natural, KnownNat, natVal' )+import GHC.Exts ( proxy#, Proxy# )++natVal'' :: forall n. KnownNat n => Natural+natVal'' = natVal' (proxy# :: Proxy# n)+{-# INLINE natVal'' #-}++natValInt :: forall n. KnownNat n => Int+natValInt = fromIntegral $ natVal'' @n+{-# INLINE natValInt #-}