dahdit 0.7.0 → 0.8.0

raw patch · 15 files changed

+514/−824 lines, 15 filesdep +primitive-unalignedPVP ok

version bump matches the API change (PVP)

Dependencies added: primitive-unaligned

API changes (from Hackage documentation)

Files

• dahdit.cabal +5/−5
• src/Dahdit.hs +4/−4
• src/Dahdit/Binary.hs +2/−0
• src/Dahdit/Fancy.hs +7/−6
• src/Dahdit/Free.hs +6/−5
• src/Dahdit/Funs.hs +26/−26
• src/Dahdit/Internal.hs +0/−144
• src/Dahdit/LiftedPrim.hs +0/−347
• src/Dahdit/LiftedPrimArray.hs +0/−123
• src/Dahdit/Mem.hs +43/−35
• src/Dahdit/Nums.hs +112/−77
• src/Dahdit/Run.hs +12/−11
• src/Dahdit/ShortWord.hs +232/−0
• src/Dahdit/Sizes.hs +48/−19
• test/Main.hs +17/−22

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.0. -- -- see: https://github.com/sol/hpack  name:           dahdit-version:        0.7.0+version:        0.8.0 synopsis:       Binary parsing and serialization with integrated size description:    Please see the README on GitHub at <https://github.com/ejconlon/dahdit#readme> category:       Data@@ -35,13 +35,11 @@       Dahdit.Funs       Dahdit.Generic       Dahdit.Iface-      Dahdit.Internal-      Dahdit.LiftedPrim-      Dahdit.LiftedPrimArray       Dahdit.Mem       Dahdit.Nums       Dahdit.Proxy       Dahdit.Run+      Dahdit.ShortWord       Dahdit.Sizes   other-modules:       Paths_dahdit@@ -84,6 +82,7 @@     , ghc-typelits-knownnat ==0.7.*     , mtl >=2.2 && <2.4     , primitive >=0.7 && <0.10+    , primitive-unaligned ==0.1.*     , text >=1.2 && <2.2     , transformers >=0.5 && <0.7     , vector >=0.12 && <0.14@@ -134,6 +133,7 @@     , ghc-typelits-knownnat ==0.7.*     , mtl >=2.2 && <2.4     , primitive >=0.7 && <0.10+    , primitive-unaligned ==0.1.*     , prop-unit >=1.0.1 && <1.1     , text >=1.2 && <2.2     , transformers >=0.5 && <0.7

@@ -7,6 +7,8 @@   , Seq (..)   , ByteArray   , Generic+  , Prim+  , PrimArray   , Proxy (..)   , GetError (..)   , prettyGetError@@ -20,8 +22,6 @@   , module Dahdit.Funs   , module Dahdit.Generic   , module Dahdit.Iface-  , module Dahdit.LiftedPrim-  , module Dahdit.LiftedPrimArray   , module Dahdit.Nums   , module Dahdit.Proxy   , module Dahdit.Sizes@@ -35,8 +35,6 @@ import Dahdit.Funs hiding (unsafePutStaticArrayN, unsafePutStaticSeqN) import Dahdit.Generic import Dahdit.Iface-import Dahdit.LiftedPrim-import Dahdit.LiftedPrimArray import Dahdit.Nums import Dahdit.Proxy import Dahdit.Run (GetError (..), GetIncCb, GetIncRequest (..), prettyGetError, runCount)@@ -44,7 +42,9 @@ import Data.ByteString (ByteString) import Data.ByteString.Short (ShortByteString) import Data.Int (Int8)+import Data.Primitive (Prim) import Data.Primitive.ByteArray (ByteArray)+import Data.Primitive.PrimArray (PrimArray) import Data.Proxy (Proxy (..)) import Data.Sequence (Seq (..)) import Data.Vector.Storable (Vector)

@@ -220,6 +220,8 @@   get = getDoubleBE   put = putDoubleBE +-- Assuming we are on little-endian arch...+ deriving via Word16LE instance Binary Word16  deriving via Int16LE instance Binary Int16

@@ -30,8 +30,6 @@   , unsafePutStaticArrayN   , unsafePutStaticSeqN   )-import Dahdit.LiftedPrim (LiftedPrim)-import Dahdit.LiftedPrimArray (LiftedPrimArray, replicateLiftedPrimArray) import Dahdit.Proxy (proxyForNatF) import Dahdit.Sizes (ByteCount (..), StaticByteSized (..), byteSizeViaStatic) import Data.ByteString.Internal (c2w)@@ -39,7 +37,10 @@ import Data.ByteString.Short.Internal (ShortByteString (..)) import Data.Coerce (coerce) import Data.Default (Default (..))+import Data.Primitive (Prim) import Data.Primitive.ByteArray (ByteArray (..), byteArrayFromListN)+import Data.Primitive.ByteArray.Unaligned (PrimUnaligned)+import Data.Primitive.PrimArray (PrimArray, replicatePrimArray) import Data.Proxy (Proxy (..)) import Data.Sequence (Seq) import qualified Data.Sequence as Seq@@ -166,17 +167,17 @@   get = fmap StaticSeq (getStaticSeq (fromInteger (natVal (Proxy :: Proxy n))) get)   put = unsafePutStaticSeqN (fromInteger (natVal (Proxy :: Proxy n))) (Just def) put . unStaticSeq -newtype StaticArray (n :: Nat) a = StaticArray {unStaticArray :: LiftedPrimArray a}+newtype StaticArray (n :: Nat) a = StaticArray {unStaticArray :: PrimArray a}   deriving stock (Show)   deriving newtype (Eq) -instance (KnownNat n, LiftedPrim a, Default a) => Default (StaticArray n a) where-  def = StaticArray (replicateLiftedPrimArray (fromInteger (natVal (Proxy :: Proxy n))) def)+instance (KnownNat n, Prim a, Default a) => Default (StaticArray n a) where+  def = StaticArray (replicatePrimArray (fromInteger (natVal (Proxy :: Proxy n))) def)  instance (KnownNat n, StaticByteSized a) => StaticByteSized (StaticArray n a) where   type StaticSize (StaticArray n a) = n * StaticSize a -instance (KnownNat n, LiftedPrim a, Default a) => Binary (StaticArray n a) where+instance (KnownNat n, Prim a, PrimUnaligned a, StaticByteSized a, Default a) => Binary (StaticArray n a) where   byteSize = byteSizeViaStatic   get = fmap StaticArray (getStaticArray (fromInteger (natVal (Proxy :: Proxy n))))   put = unsafePutStaticArrayN (fromInteger (natVal (Proxy :: Proxy n))) (Just def) . unStaticArray

@@ -16,8 +16,6 @@ where  import Control.Monad.Free.Church (F (..))-import Dahdit.LiftedPrim (LiftedPrim)-import Dahdit.LiftedPrimArray (LiftedPrimArray) import Dahdit.Nums   ( DoubleBE   , DoubleLE@@ -43,7 +41,10 @@ import Dahdit.Sizes (ByteCount, ElemCount, StaticByteSized (..)) import Data.ByteString.Short (ShortByteString) import Data.Int (Int8)-import Data.Primitive (ByteArray)+import Data.Primitive (Prim)+import Data.Primitive.ByteArray (ByteArray)+import Data.Primitive.ByteArray.Unaligned (PrimUnaligned)+import Data.Primitive.PrimArray (PrimArray) import Data.Proxy (Proxy (..)) import Data.Sequence (Seq) import Data.Text (Text)@@ -57,7 +58,7 @@   fmap f (GetStaticSeqF n g k) = GetStaticSeqF n g (f . k)  data GetStaticArrayF a where-  GetStaticArrayF :: (LiftedPrim z) => !ElemCount -> Proxy z -> (LiftedPrimArray z -> a) -> GetStaticArrayF a+  GetStaticArrayF :: (Prim z, PrimUnaligned z) => !ElemCount -> Proxy z -> (PrimArray z -> a) -> GetStaticArrayF a  instance Functor GetStaticArrayF where   fmap f (GetStaticArrayF n p k) = GetStaticArrayF n p (f . k)@@ -126,7 +127,7 @@   fmap f (PutStaticSeqF n z p s k) = PutStaticSeqF n z p s (f k)  data PutStaticArrayF a where-  PutStaticArrayF :: (LiftedPrim z) => !ElemCount -> !(Maybe z) -> !(LiftedPrimArray z) -> a -> PutStaticArrayF a+  PutStaticArrayF :: (Prim z, PrimUnaligned z) => !ElemCount -> !(Maybe z) -> !(PrimArray z) -> a -> PutStaticArrayF a  instance Functor PutStaticArrayF where   fmap f (PutStaticArrayF n z a k) = PutStaticArrayF n z a (f k)

@@ -31,7 +31,7 @@   , getStaticSeq   , getStaticArray   , getByteArray-  , getLiftedPrimArray+  , getPrimArray   , getExpect   , getLookAhead   , getRemainingSize@@ -40,7 +40,7 @@   , getRemainingStaticSeq   , getRemainingStaticArray   , getRemainingByteArray-  , getRemainingLiftedPrimArray+  , getRemainingPrimArray   , getUnfold   , putWord8   , putInt8@@ -74,7 +74,7 @@   , putStaticArray   , unsafePutStaticArrayN   , putByteArray-  , putLiftedPrimArray+  , putPrimArray   , putStaticHint   ) where@@ -96,8 +96,6 @@   , PutStaticSeqF (..)   , ScopeMode (..)   )-import Dahdit.LiftedPrim (LiftedPrim (..))-import Dahdit.LiftedPrimArray (LiftedPrimArray (..), lengthLiftedPrimArray) import Dahdit.Nums   ( DoubleBE   , DoubleLE@@ -127,8 +125,10 @@ import Data.Coerce (coerce) import Data.Foldable (traverse_) import Data.Int (Int8)-import Data.Primitive (sizeofByteArray)-import Data.Primitive.ByteArray (ByteArray)+import Data.Primitive (Prim, sizeOfType, sizeofByteArray)+import Data.Primitive.ByteArray (ByteArray (..))+import Data.Primitive.ByteArray.Unaligned (PrimUnaligned)+import Data.Primitive.PrimArray (PrimArray (..), sizeofPrimArray) import Data.Proxy (Proxy (..)) import Data.Sequence (Seq (..)) import qualified Data.Sequence as Seq@@ -244,16 +244,16 @@ getStaticSeq n g = Get (F (\x y -> y (GetFStaticSeq (GetStaticSeqF n g x))))  -- | Get PrimArray of statically-sized elements-getStaticArray :: (LiftedPrim a) => ElemCount -> Get (LiftedPrimArray a)+getStaticArray :: (Prim a, PrimUnaligned a) => ElemCount -> Get (PrimArray a) getStaticArray n = Get (F (\x y -> y (GetFStaticArray (GetStaticArrayF n (Proxy :: Proxy a) x))))  getByteArray :: ByteCount -> Get ByteArray getByteArray bc = Get (F (\x y -> y (GetFByteArray bc x))) -getLiftedPrimArray :: (LiftedPrim a) => Proxy a -> ElemCount -> Get (LiftedPrimArray a)-getLiftedPrimArray prox ec =+getPrimArray :: (StaticByteSized a) => Proxy a -> ElemCount -> Get (PrimArray a)+getPrimArray prox ec =   let bc = staticByteSize prox * coerce ec-  in  fmap LiftedPrimArray (getByteArray bc)+  in  fmap (\(ByteArray a) -> PrimArray a) (getByteArray bc)  getLookAhead :: Get a -> Get a getLookAhead g = Get (F (\x y -> y (GetFLookAhead (GetLookAheadF g x))))@@ -291,34 +291,34 @@             ++ ")"         ) -getRemainingStaticArray :: (LiftedPrim a) => Proxy a -> Get (LiftedPrimArray a)-getRemainingStaticArray prox = do-  let ebc = staticByteSize prox-  bc <- getRemainingSize+getRemainingStaticArray :: forall a. (Prim a, PrimUnaligned a) => Proxy a -> Get (PrimArray a)+getRemainingStaticArray _ = do+  let ebc = sizeOfType @a+  bc <- fmap unByteCount getRemainingSize   let left = rem bc ebc   if left == 0-    then getStaticArray (coerce (div bc ebc))+    then getStaticArray (ElemCount (div bc ebc))     else       fail         ( "Leftover bytes for remaining static array (have "-            ++ show (unByteCount left)+            ++ show left             ++ ", need "-            ++ show (unByteCount ebc)+            ++ show ebc             ++ ")"         )  getRemainingByteArray :: Get ByteArray getRemainingByteArray = getRemainingSize >>= getByteArray -getRemainingLiftedPrimArray :: (LiftedPrim a) => Proxy a -> Get (LiftedPrimArray a)-getRemainingLiftedPrimArray prox = do+getRemainingPrimArray :: (StaticByteSized a) => Proxy a -> Get (PrimArray a)+getRemainingPrimArray prox = do   let ebc = staticByteSize prox   bc <- getRemainingSize   let left = rem bc ebc   if left == 0     then do       let ec = coerce (div bc ebc)-      getLiftedPrimArray prox ec+      getPrimArray prox ec     else       fail         ( "Leftover bytes for remaining lifted prim array (have "@@ -445,12 +445,12 @@ unsafePutStaticSeqN n mz p s = PutM (F (\x y -> y (PutFStaticSeq (PutStaticSeqF n mz p s (x ())))))  -- | Put Array of statically-sized elements-putStaticArray :: (LiftedPrim a) => LiftedPrimArray a -> Put+putStaticArray :: (Prim a, PrimUnaligned a) => PrimArray a -> Put putStaticArray a =-  let ec = lengthLiftedPrimArray a+  let ec = ElemCount (sizeofPrimArray a)   in  unsafePutStaticArrayN ec Nothing a -unsafePutStaticArrayN :: (LiftedPrim a) => ElemCount -> Maybe a -> LiftedPrimArray a -> Put+unsafePutStaticArrayN :: (Prim a, PrimUnaligned a) => ElemCount -> Maybe a -> PrimArray a -> Put unsafePutStaticArrayN n mz a = PutM (F (\x y -> y (PutFStaticArray (PutStaticArrayF n mz a (x ())))))  putByteArray :: ByteArray -> Put@@ -458,8 +458,8 @@   let bc = coerce (sizeofByteArray arr)   in  PutM (F (\x y -> y (PutFByteArray bc arr (x ())))) -putLiftedPrimArray :: LiftedPrimArray a -> Put-putLiftedPrimArray = putByteArray . unLiftedPrimArray+putPrimArray :: PrimArray a -> Put+putPrimArray = putByteArray . (\(PrimArray a) -> ByteArray a)  putStaticHint :: (StaticByteSized a) => (a -> Put) -> a -> Put putStaticHint p a =

@@ -1,144 +0,0 @@-module Dahdit.Internal where--import Data.Bits (Bits (..))-import Data.Int (Int16, Int32, Int64, Int8)-import Data.ShortWord (Int24, Word24)-import Data.Word (Word16, Word32, Word64, Word8)-import GHC.Float (castDoubleToWord64, castFloatToWord32, castWord32ToFloat, castWord64ToDouble)-import GHC.TypeLits (Nat)--newtype ViaFromIntegral (n :: Nat) x y = ViaFromIntegral {unViaFromIntegral :: y}-  deriving newtype (Num)---- Types that can swap endianness - swapEndian is its own inverse-class (Num w) => SwapEndian w where-  swapEndian :: w -> w--instance (SwapEndian x, Integral x, Integral y) => SwapEndian (ViaFromIntegral n x y) where-  swapEndian = ViaFromIntegral . fromIntegral @x @y . swapEndian . fromIntegral @y @x . unViaFromIntegral--instance SwapEndian Word8 where-  swapEndian = id--instance SwapEndian Int8 where-  swapEndian = id--instance SwapEndian Word16 where-  swapEndian w =-    let (!b0, !b1) = unMkWord16LE w-    in  mkWord16LE b1 b0--deriving via (ViaFromIntegral n Word16 Int16) instance SwapEndian Int16--instance SwapEndian Word24 where-  swapEndian w =-    let (!b0, !b1, !b2) = unMkWord24LE w-    in  mkWord24LE b2 b1 b0--deriving via (ViaFromIntegral n Word24 Int24) instance SwapEndian Int24--instance SwapEndian Word32 where-  swapEndian w =-    let (!b0, !b1, !b2, !b3) = unMkWord32LE w-    in  mkWord32LE b3 b2 b1 b0--deriving via (ViaFromIntegral n Word32 Int32) instance SwapEndian Int32--instance SwapEndian Word64 where-  swapEndian w =-    let (!b0, !b1, !b2, !b3, !b4, !b5, !b6, !b7) = unMkWord64LE w-    in  mkWord64LE b7 b6 b5 b4 b3 b2 b1 b0--deriving via (ViaFromIntegral n Word64 Int64) instance SwapEndian Int64--instance SwapEndian Float where-  swapEndian w =-    let (!b0, !b1, !b2, !b3) = unMkFloatLE w-    in  mkFloatLE b3 b2 b1 b0--instance SwapEndian Double where-  swapEndian w =-    let (!b0, !b1, !b2, !b3, !b4, !b5, !b6, !b7) = unMkDoubleLE w-    in  mkDoubleLE b7 b6 b5 b4 b3 b2 b1 b0--mkWord16LE :: Word8 -> Word8 -> Word16-mkWord16LE b0 b1 = (fromIntegral b1 `unsafeShiftL` 8) .|. fromIntegral b0--unMkWord16LE :: Word16 -> (Word8, Word8)-unMkWord16LE w =-  let b0 = fromIntegral w-      b1 = fromIntegral (w `shiftR` 8)-  in  (b0, b1)--mkWord24LE :: Word8 -> Word8 -> Word8 -> Word24-mkWord24LE b0 b1 b2 = fromIntegral (mkWord32LE b0 b1 b2 0)--unMkWord24LE :: Word24 -> (Word8, Word8, Word8)-unMkWord24LE w =-  let v = fromIntegral w-      (!b0, !b1, !b2, _) = unMkWord32LE v-  in  (b0, b1, b2)--mkWord32LE :: Word8 -> Word8 -> Word8 -> Word8 -> Word32-mkWord32LE b0 b1 b2 b3 =-  (fromIntegral b3 `unsafeShiftL` 24)-    .|. (fromIntegral b2 `unsafeShiftL` 16)-    .|. (fromIntegral b1 `unsafeShiftL` 8)-    .|. fromIntegral b0--unMkWord32LE :: Word32 -> (Word8, Word8, Word8, Word8)-unMkWord32LE w =-  let b0 = fromIntegral w-      b1 = fromIntegral (w `shiftR` 8)-      b2 = fromIntegral (w `shiftR` 16)-      b3 = fromIntegral (w `shiftR` 24)-  in  (b0, b1, b2, b3)--mkWord64LE :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word64-mkWord64LE b0 b1 b2 b3 b4 b5 b6 b7 =-  (fromIntegral b7 `unsafeShiftL` 56)-    .|. (fromIntegral b6 `unsafeShiftL` 48)-    .|. (fromIntegral b5 `unsafeShiftL` 40)-    .|. (fromIntegral b4 `unsafeShiftL` 32)-    .|. (fromIntegral b3 `unsafeShiftL` 24)-    .|. (fromIntegral b2 `unsafeShiftL` 16)-    .|. (fromIntegral b1 `unsafeShiftL` 8)-    .|. fromIntegral b0--unMkWord64LE :: Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)-unMkWord64LE w =-  let b0 = fromIntegral w-      b1 = fromIntegral (w `shiftR` 8)-      b2 = fromIntegral (w `shiftR` 16)-      b3 = fromIntegral (w `shiftR` 24)-      b4 = fromIntegral (w `shiftR` 32)-      b5 = fromIntegral (w `shiftR` 40)-      b6 = fromIntegral (w `shiftR` 48)-      b7 = fromIntegral (w `shiftR` 56)-  in  (b0, b1, b2, b3, b4, b5, b6, b7)--mkFloatLE :: Word8 -> Word8 -> Word8 -> Word8 -> Float-mkFloatLE b0 b1 b2 b3 = castWord32ToFloat (mkWord32LE b0 b1 b2 b3)--unMkFloatLE :: Float -> (Word8, Word8, Word8, Word8)-unMkFloatLE f = unMkWord32LE (castFloatToWord32 f)--mkDoubleLE :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Double-mkDoubleLE b0 b1 b2 b3 b4 b5 b6 b7 = castWord64ToDouble (mkWord64LE b0 b1 b2 b3 b4 b5 b6 b7)--unMkDoubleLE :: Double -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)-unMkDoubleLE f = unMkWord64LE (castDoubleToWord64 f)--class (Num le, Num be) => EndianPair (n :: Nat) le be | le -> n, be -> n, le -> be, be -> le where-  toLittleEndian :: be -> le-  toBigEndian :: le -> be--newtype ViaEndianPair (n :: Nat) le be = ViaEndianPair {unViaEndianPair :: be}--instance EndianPair 1 Word8 Word8 where-  toLittleEndian = id-  toBigEndian = id--instance EndianPair 1 Int8 Int8 where-  toLittleEndian = id-  toBigEndian = id

@@ -1,347 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--module Dahdit.LiftedPrim-  ( LiftedPrim (..)-  , indexArrayLiftedInElems-  , writeArrayLiftedInElems-  , indexPtrLiftedInElems-  , writePtrLiftedInElems-  , setByteArrayLifted-  )-where--import Control.Monad.Primitive (PrimMonad (..))-import Dahdit.Internal-  ( EndianPair (..)-  , ViaEndianPair (..)-  , ViaFromIntegral (..)-  , mkDoubleLE-  , mkFloatLE-  , mkWord16LE-  , mkWord24LE-  , mkWord32LE-  , mkWord64LE-  , unMkDoubleLE-  , unMkFloatLE-  , unMkWord16LE-  , unMkWord24LE-  , unMkWord32LE-  , unMkWord64LE-  )-import Dahdit.Nums-  ( DoubleBE-  , DoubleLE (..)-  , FloatBE-  , FloatLE (..)-  , Int16BE-  , Int16LE (..)-  , Int24BE-  , Int24LE (..)-  , Int32BE-  , Int32LE (..)-  , Int64BE-  , Int64LE (..)-  , Word16BE-  , Word16LE (..)-  , Word24BE-  , Word24LE (..)-  , Word32BE-  , Word32LE (..)-  , Word64BE-  , Word64LE (..)-  )-import Dahdit.Proxy (proxyFor)-import Dahdit.Sizes (ByteCount (..), ElemCount (..), StaticByteSized (..))-import Data.Coerce (coerce)-import Data.Foldable (for_)-import Data.Int (Int8)-import Data.Primitive.ByteArray-  ( ByteArray-  , MutableByteArray-  , indexByteArray-  , writeByteArray-  )-import Data.Primitive.Ptr (indexOffPtr, writeOffPtr)-import Data.Proxy (Proxy (..))-import Data.Word (Word8)-import Foreign.Ptr (Ptr)---- | This is a stripped-down version of 'Prim' that is possible for a human to implement.--- It's all about reading and writing structures from lifted byte arrays and pointers.-class (StaticByteSized a) => LiftedPrim a where-  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> a-  writeArrayLiftedInBytes :: (PrimMonad m) => MutableByteArray (PrimState m) -> ByteCount -> a -> m ()-  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> a-  writePtrLiftedInBytes :: (PrimMonad m) => Ptr Word8 -> ByteCount -> a -> m ()--indexArrayLiftedInElems :: (LiftedPrim a) => Proxy a -> ByteArray -> ElemCount -> a-indexArrayLiftedInElems prox arr pos =-  indexArrayLiftedInBytes arr (coerce pos * staticByteSize prox)--writeArrayLiftedInElems :: (PrimMonad m, LiftedPrim a) => MutableByteArray (PrimState m) -> ElemCount -> a -> m ()-writeArrayLiftedInElems arr pos val =-  writeArrayLiftedInBytes arr (coerce pos * staticByteSize (proxyFor val)) val--indexPtrLiftedInElems :: (LiftedPrim a) => Proxy a -> Ptr Word8 -> ElemCount -> a-indexPtrLiftedInElems prox ptr pos =-  indexPtrLiftedInBytes ptr (coerce pos * staticByteSize prox)--writePtrLiftedInElems :: (PrimMonad m, LiftedPrim a) => Ptr Word8 -> ElemCount -> a -> m ()-writePtrLiftedInElems ptr pos val =-  writePtrLiftedInBytes ptr (coerce pos * staticByteSize (proxyFor val)) val--instance LiftedPrim Word8 where-  indexArrayLiftedInBytes arr = indexByteArray arr . coerce-  writeArrayLiftedInBytes marr = writeByteArray marr . coerce-  indexPtrLiftedInBytes ptr = indexOffPtr ptr . coerce-  writePtrLiftedInBytes ptr = writeOffPtr ptr . coerce--instance LiftedPrim Int8 where-  indexArrayLiftedInBytes arr = indexByteArray arr . coerce-  writeArrayLiftedInBytes marr = writeByteArray marr . coerce-  indexPtrLiftedInBytes ptr = indexOffPtr (coerce ptr) . coerce-  writePtrLiftedInBytes ptr = writeOffPtr (coerce ptr) . coerce---- | NOTE: Relies on same byte width of both types!-instance (Integral x, LiftedPrim x, Integral y, n ~ StaticSize x) => LiftedPrim (ViaFromIntegral n x y) where-  indexArrayLiftedInBytes arr off = ViaFromIntegral (fromIntegral (indexArrayLiftedInBytes arr off :: x))-  writeArrayLiftedInBytes arr off val = let x = fromIntegral (unViaFromIntegral val) :: x in writeArrayLiftedInBytes arr off x-  indexPtrLiftedInBytes ptr = ViaFromIntegral . fromIntegral @x @y . indexPtrLiftedInBytes ptr-  writePtrLiftedInBytes ptr off (ViaFromIntegral y) = writePtrLiftedInBytes ptr off (fromIntegral y :: x)--instance LiftedPrim Word16LE where-  indexArrayLiftedInBytes arr off =-    let !b0 = indexByteArray arr (coerce off)-        !b1 = indexByteArray arr (coerce off + 1)-    in  Word16LE (mkWord16LE b0 b1)--  writeArrayLiftedInBytes arr off w =-    let (!b0, !b1) = unMkWord16LE (unWord16LE w)-    in  writeByteArray arr (coerce off) b0-          *> writeByteArray arr (coerce off + 1) b1--  indexPtrLiftedInBytes ptr off =-    let !b0 = indexOffPtr ptr (coerce off)-        !b1 = indexOffPtr ptr (coerce off + 1)-    in  Word16LE (mkWord16LE b0 b1)--  writePtrLiftedInBytes ptr off w =-    let (!b0, !b1) = unMkWord16LE (unWord16LE w)-    in  writeOffPtr ptr (coerce off) b0-          *> writeOffPtr ptr (coerce off + 1) b1--instance LiftedPrim Word24LE where-  indexArrayLiftedInBytes arr off =-    let !b0 = indexByteArray arr (coerce off)-        !b1 = indexByteArray arr (coerce off + 1)-        !b2 = indexByteArray arr (coerce off + 2)-    in  Word24LE (mkWord24LE b0 b1 b2)--  writeArrayLiftedInBytes arr off w = do-    let (!b0, !b1, !b2) = unMkWord24LE (unWord24LE w)-    writeByteArray arr (coerce off) b0-    writeByteArray arr (coerce off + 1) b1-    writeByteArray arr (coerce off + 2) b2--  indexPtrLiftedInBytes ptr off =-    let !b0 = indexOffPtr ptr (coerce off)-        !b1 = indexOffPtr ptr (coerce off + 1)-        !b2 = indexOffPtr ptr (coerce off + 2)-    in  Word24LE (mkWord24LE b0 b1 b2)--  writePtrLiftedInBytes ptr off w =-    let (!b0, !b1, !b2) = unMkWord24LE (unWord24LE w)-    in  writeOffPtr ptr (coerce off) b0-          *> writeOffPtr ptr (coerce off + 1) b1-          *> writeOffPtr ptr (coerce off + 2) b2--instance LiftedPrim Word32LE where-  indexArrayLiftedInBytes arr off =-    let !b0 = indexByteArray arr (coerce off)-        !b1 = indexByteArray arr (coerce off + 1)-        !b2 = indexByteArray arr (coerce off + 2)-        !b3 = indexByteArray arr (coerce off + 3)-    in  Word32LE (mkWord32LE b0 b1 b2 b3)--  writeArrayLiftedInBytes arr off w = do-    let (!b0, !b1, !b2, !b3) = unMkWord32LE (unWord32LE w)-    writeByteArray arr (coerce off) b0-    writeByteArray arr (coerce off + 1) b1-    writeByteArray arr (coerce off + 2) b2-    writeByteArray arr (coerce off + 3) b3--  indexPtrLiftedInBytes ptr off =-    let !b0 = indexOffPtr ptr (coerce off)-        !b1 = indexOffPtr ptr (coerce off + 1)-        !b2 = indexOffPtr ptr (coerce off + 2)-        !b3 = indexOffPtr ptr (coerce off + 3)-    in  Word32LE (mkWord32LE b0 b1 b2 b3)--  writePtrLiftedInBytes ptr off w =-    let (!b0, !b1, !b2, !b3) = unMkWord32LE (unWord32LE w)-    in  writeOffPtr ptr (coerce off) b0-          *> writeOffPtr ptr (coerce off + 1) b1-          *> writeOffPtr ptr (coerce off + 2) b2-          *> writeOffPtr ptr (coerce off + 3) b3--instance LiftedPrim Word64LE where-  indexArrayLiftedInBytes arr off =-    let !b0 = indexArrayLiftedInBytes arr (coerce off)-        !b1 = indexArrayLiftedInBytes arr (coerce off + 1)-        !b2 = indexArrayLiftedInBytes arr (coerce off + 2)-        !b3 = indexArrayLiftedInBytes arr (coerce off + 3)-        !b4 = indexArrayLiftedInBytes arr (coerce off + 4)-        !b5 = indexArrayLiftedInBytes arr (coerce off + 5)-        !b6 = indexArrayLiftedInBytes arr (coerce off + 6)-        !b7 = indexArrayLiftedInBytes arr (coerce off + 7)-    in  Word64LE (mkWord64LE b0 b1 b2 b3 b4 b5 b6 b7)--  writeArrayLiftedInBytes arr off w = do-    let (!b0, !b1, !b2, !b3, !b4, !b5, !b6, !b7) = unMkWord64LE (unWord64LE w)-    writeByteArray arr (coerce off) b0-    writeByteArray arr (coerce off + 1) b1-    writeByteArray arr (coerce off + 2) b2-    writeByteArray arr (coerce off + 3) b3-    writeByteArray arr (coerce off + 4) b4-    writeByteArray arr (coerce off + 5) b5-    writeByteArray arr (coerce off + 6) b6-    writeByteArray arr (coerce off + 7) b7--  indexPtrLiftedInBytes ptr off =-    let !b0 = indexOffPtr ptr (coerce off)-        !b1 = indexOffPtr ptr (coerce off + 1)-        !b2 = indexOffPtr ptr (coerce off + 2)-        !b3 = indexOffPtr ptr (coerce off + 3)-        !b4 = indexOffPtr ptr (coerce off + 4)-        !b5 = indexOffPtr ptr (coerce off + 5)-        !b6 = indexOffPtr ptr (coerce off + 6)-        !b7 = indexOffPtr ptr (coerce off + 7)-    in  Word64LE (mkWord64LE b0 b1 b2 b3 b4 b5 b6 b7)--  writePtrLiftedInBytes ptr off w =-    let (!b0, !b1, !b2, !b3, !b4, !b5, !b6, !b7) = unMkWord64LE (unWord64LE w)-    in  writeOffPtr ptr (coerce off) b0-          *> writeOffPtr ptr (coerce off + 1) b1-          *> writeOffPtr ptr (coerce off + 2) b2-          *> writeOffPtr ptr (coerce off + 3) b3-          *> writeOffPtr ptr (coerce off + 4) b4-          *> writeOffPtr ptr (coerce off + 5) b5-          *> writeOffPtr ptr (coerce off + 6) b6-          *> writeOffPtr ptr (coerce off + 7) b7--instance LiftedPrim FloatLE where-  indexArrayLiftedInBytes arr off =-    let !b0 = indexByteArray arr (coerce off)-        !b1 = indexByteArray arr (coerce off + 1)-        !b2 = indexByteArray arr (coerce off + 2)-        !b3 = indexByteArray arr (coerce off + 3)-    in  FloatLE (mkFloatLE b0 b1 b2 b3)--  writeArrayLiftedInBytes arr off f = do-    let (!b0, !b1, !b2, !b3) = unMkFloatLE (unFloatLE f)-    writeByteArray arr (coerce off) b0-    writeByteArray arr (coerce off + 1) b1-    writeByteArray arr (coerce off + 2) b2-    writeByteArray arr (coerce off + 3) b3--  indexPtrLiftedInBytes ptr off =-    let !b0 = indexOffPtr ptr (coerce off)-        !b1 = indexOffPtr ptr (coerce off + 1)-        !b2 = indexOffPtr ptr (coerce off + 2)-        !b3 = indexOffPtr ptr (coerce off + 3)-    in  FloatLE (mkFloatLE b0 b1 b2 b3)--  writePtrLiftedInBytes ptr off f =-    let (!b0, !b1, !b2, !b3) = unMkFloatLE (unFloatLE f)-    in  writeOffPtr ptr (coerce off) b0-          *> writeOffPtr ptr (coerce off + 1) b1-          *> writeOffPtr ptr (coerce off + 2) b2-          *> writeOffPtr ptr (coerce off + 3) b3--instance LiftedPrim DoubleLE where-  indexArrayLiftedInBytes arr off =-    let !b0 = indexArrayLiftedInBytes arr (coerce off)-        !b1 = indexArrayLiftedInBytes arr (coerce off + 1)-        !b2 = indexArrayLiftedInBytes arr (coerce off + 2)-        !b3 = indexArrayLiftedInBytes arr (coerce off + 3)-        !b4 = indexArrayLiftedInBytes arr (coerce off + 4)-        !b5 = indexArrayLiftedInBytes arr (coerce off + 5)-        !b6 = indexArrayLiftedInBytes arr (coerce off + 6)-        !b7 = indexArrayLiftedInBytes arr (coerce off + 7)-    in  DoubleLE (mkDoubleLE b0 b1 b2 b3 b4 b5 b6 b7)--  writeArrayLiftedInBytes arr off f = do-    let (!b0, !b1, !b2, !b3, !b4, !b5, !b6, !b7) = unMkDoubleLE (unDoubleLE f)-    writeByteArray arr (coerce off) b0-    writeByteArray arr (coerce off + 1) b1-    writeByteArray arr (coerce off + 2) b2-    writeByteArray arr (coerce off + 3) b3-    writeByteArray arr (coerce off + 4) b4-    writeByteArray arr (coerce off + 5) b5-    writeByteArray arr (coerce off + 6) b6-    writeByteArray arr (coerce off + 7) b7--  indexPtrLiftedInBytes ptr off =-    let !b0 = indexOffPtr ptr (coerce off)-        !b1 = indexOffPtr ptr (coerce off + 1)-        !b2 = indexOffPtr ptr (coerce off + 2)-        !b3 = indexOffPtr ptr (coerce off + 3)-        !b4 = indexOffPtr ptr (coerce off + 4)-        !b5 = indexOffPtr ptr (coerce off + 5)-        !b6 = indexOffPtr ptr (coerce off + 6)-        !b7 = indexOffPtr ptr (coerce off + 7)-    in  DoubleLE (mkDoubleLE b0 b1 b2 b3 b4 b5 b6 b7)--  writePtrLiftedInBytes ptr off f =-    let (!b0, !b1, !b2, !b3, !b4, !b5, !b6, !b7) = unMkDoubleLE (unDoubleLE f)-    in  writeOffPtr ptr (coerce off) b0-          *> writeOffPtr ptr (coerce off + 1) b1-          *> writeOffPtr ptr (coerce off + 2) b2-          *> writeOffPtr ptr (coerce off + 3) b3-          *> writeOffPtr ptr (coerce off + 4) b4-          *> writeOffPtr ptr (coerce off + 5) b5-          *> writeOffPtr ptr (coerce off + 6) b6-          *> writeOffPtr ptr (coerce off + 7) b7--instance (LiftedPrim le, EndianPair n le be, n ~ StaticSize le) => LiftedPrim (ViaEndianPair n le be) where-  indexArrayLiftedInBytes arr off = ViaEndianPair (toBigEndian (indexArrayLiftedInBytes arr off))-  writeArrayLiftedInBytes arr off = writeArrayLiftedInBytes arr off . toLittleEndian . unViaEndianPair-  indexPtrLiftedInBytes ptr off = ViaEndianPair (toBigEndian (indexPtrLiftedInBytes ptr off))-  writePtrLiftedInBytes ptr off = writePtrLiftedInBytes ptr off . toLittleEndian . unViaEndianPair--deriving via (ViaFromIntegral 2 Word16LE Int16LE) instance LiftedPrim Int16LE--deriving via (ViaFromIntegral 3 Word24LE Int24LE) instance LiftedPrim Int24LE--deriving via (ViaFromIntegral 4 Word32LE Int32LE) instance LiftedPrim Int32LE--deriving via (ViaFromIntegral 8 Word64LE Int64LE) instance LiftedPrim Int64LE--deriving via (ViaEndianPair 2 Word16LE Word16BE) instance LiftedPrim Word16BE--deriving via (ViaEndianPair 2 Int16LE Int16BE) instance LiftedPrim Int16BE--deriving via (ViaEndianPair 3 Word24LE Word24BE) instance LiftedPrim Word24BE--deriving via (ViaEndianPair 3 Int24LE Int24BE) instance LiftedPrim Int24BE--deriving via (ViaEndianPair 4 Word32LE Word32BE) instance LiftedPrim Word32BE--deriving via (ViaEndianPair 4 Int32LE Int32BE) instance LiftedPrim Int32BE--deriving via (ViaEndianPair 8 Word64LE Word64BE) instance LiftedPrim Word64BE--deriving via (ViaEndianPair 8 Int64LE Int64BE) instance LiftedPrim Int64BE--deriving via (ViaEndianPair 4 FloatLE FloatBE) instance LiftedPrim FloatBE--deriving via (ViaEndianPair 8 DoubleLE DoubleBE) instance LiftedPrim DoubleBE---- | Fill a byte array with the given value-setByteArrayLifted-  :: (PrimMonad m, LiftedPrim a) => MutableByteArray (PrimState m) -> ByteCount -> ByteCount -> a -> m ()-setByteArrayLifted arr off len val = do-  let elemSize = staticByteSize (proxyFor val)-      elemLen = div (coerce len) elemSize-  for_ [0 .. elemLen - 1] $ \pos ->-    writeArrayLiftedInBytes arr (off + pos * elemSize) val

@@ -1,123 +0,0 @@-module Dahdit.LiftedPrimArray-  ( LiftedPrimArray (..)-  , MutableLiftedPrimArray (..)-  , emptyLiftedPrimArray-  , indexLiftedPrimArray-  , writeLiftedPrimArray-  , freezeLiftedPrimArray-  , thawLiftedPrimArray-  , unsafeFreezeLiftedPrimArray-  , unsafeThawLiftedPrimArray-  , liftedPrimArrayFromListN-  , liftedPrimArrayFromList-  , generateLiftedPrimArray-  , sizeofLiftedPrimArray-  , lengthLiftedPrimArray-  , cloneLiftedPrimArray-  , replicateLiftedPrimArray-  )-where--import Control.Monad.Primitive (PrimMonad (..))-import Dahdit.LiftedPrim-  ( LiftedPrim (..)-  , indexArrayLiftedInElems-  , writeArrayLiftedInElems-  )-import Dahdit.Proxy (proxyFor, proxyForF)-import Dahdit.Sizes (ByteCount (..), ElemCount (..), StaticByteSized (..))-import Data.Coerce (coerce)-import Data.Default (Default (..))-import Data.Foldable (for_)-import Data.Primitive.ByteArray-  ( ByteArray-  , MutableByteArray-  , cloneByteArray-  , emptyByteArray-  , freezeByteArray-  , newByteArray-  , runByteArray-  , sizeofByteArray-  , thawByteArray-  , unsafeFreezeByteArray-  , unsafeThawByteArray-  )-import Data.Proxy (Proxy (..))-import Data.STRef (modifySTRef', newSTRef, readSTRef)--newtype LiftedPrimArray a = LiftedPrimArray {unLiftedPrimArray :: ByteArray}-  deriving stock (Show)-  deriving newtype (Eq, Ord, Semigroup, Monoid)--instance Default (LiftedPrimArray a) where-  def = emptyLiftedPrimArray--newtype MutableLiftedPrimArray m a = MutableLiftedPrimArray {unMutableLiftedPrimArray :: MutableByteArray m}-  deriving newtype (Eq)--emptyLiftedPrimArray :: LiftedPrimArray a-emptyLiftedPrimArray = LiftedPrimArray emptyByteArray--indexLiftedPrimArray :: (LiftedPrim a) => LiftedPrimArray a -> ElemCount -> a-indexLiftedPrimArray (LiftedPrimArray arr) = indexArrayLiftedInElems Proxy arr--writeLiftedPrimArray :: (LiftedPrim a, PrimMonad m) => MutableLiftedPrimArray (PrimState m) a -> ElemCount -> a -> m ()-writeLiftedPrimArray (MutableLiftedPrimArray arr) = writeArrayLiftedInElems arr--freezeLiftedPrimArray-  :: (PrimMonad m) => MutableLiftedPrimArray (PrimState m) a -> ElemCount -> ElemCount -> m (LiftedPrimArray a)-freezeLiftedPrimArray (MutableLiftedPrimArray arr) off len = fmap LiftedPrimArray (freezeByteArray arr (coerce off) (coerce len))--unsafeFreezeLiftedPrimArray :: (PrimMonad m) => MutableLiftedPrimArray (PrimState m) a -> m (LiftedPrimArray a)-unsafeFreezeLiftedPrimArray (MutableLiftedPrimArray arr) = fmap LiftedPrimArray (unsafeFreezeByteArray arr)--thawLiftedPrimArray-  :: (PrimMonad m) => LiftedPrimArray a -> ElemCount -> ElemCount -> m (MutableLiftedPrimArray (PrimState m) a)-thawLiftedPrimArray (LiftedPrimArray arr) off len = fmap MutableLiftedPrimArray (thawByteArray arr (coerce off) (coerce len))--unsafeThawLiftedPrimArray :: (PrimMonad m) => LiftedPrimArray a -> m (MutableLiftedPrimArray (PrimState m) a)-unsafeThawLiftedPrimArray (LiftedPrimArray arr) = fmap MutableLiftedPrimArray (unsafeThawByteArray arr)--liftedPrimArrayFromListN :: (LiftedPrim a) => ElemCount -> [a] -> LiftedPrimArray a-liftedPrimArrayFromListN n xs = LiftedPrimArray $ runByteArray $ do-  let elemSize = staticByteSize (proxyForF xs)-      len = coerce n * coerce elemSize-  arr <- newByteArray len-  offRef <- newSTRef 0-  for_ xs $ \x -> do-    off <- readSTRef offRef-    writeArrayLiftedInBytes arr off x-    modifySTRef' offRef (elemSize +)-  pure arr--liftedPrimArrayFromList :: (LiftedPrim a) => [a] -> LiftedPrimArray a-liftedPrimArrayFromList xs = liftedPrimArrayFromListN (coerce (length xs)) xs--generateLiftedPrimArray :: (LiftedPrim a) => ElemCount -> (ElemCount -> a) -> LiftedPrimArray a-generateLiftedPrimArray n f = liftedPrimArrayFromListN n (fmap f [0 .. n - 1])--sizeofLiftedPrimArray :: LiftedPrimArray a -> ByteCount-sizeofLiftedPrimArray (LiftedPrimArray arr) = coerce (sizeofByteArray arr)--lengthLiftedPrimArray :: (LiftedPrim a) => LiftedPrimArray a -> ElemCount-lengthLiftedPrimArray pa@(LiftedPrimArray arr) =-  let elemSize = coerce (staticByteSize (proxyForF pa))-      arrSize = sizeofByteArray arr-  in  coerce (div arrSize elemSize)--cloneLiftedPrimArray :: (LiftedPrim a) => LiftedPrimArray a -> ElemCount -> ElemCount -> LiftedPrimArray a-cloneLiftedPrimArray pa@(LiftedPrimArray arr) off len =-  let elemSize = staticByteSize (proxyForF pa)-      byteOff = coerce off * elemSize-      byteLen = coerce len * elemSize-      arr' = cloneByteArray arr (coerce byteOff) (coerce byteLen)-  in  LiftedPrimArray arr'--replicateLiftedPrimArray :: (LiftedPrim a) => ElemCount -> a -> LiftedPrimArray a-replicateLiftedPrimArray len val = LiftedPrimArray $ runByteArray $ do-  let elemSize = staticByteSize (proxyFor val)-      byteLen = coerce len * elemSize-  arr <- newByteArray (coerce byteLen)-  for_ [0 .. len - 1] $ \pos ->-    writeArrayLiftedInBytes arr (coerce pos * elemSize) val-  pure arr

@@ -1,3 +1,5 @@+{-# LANGUAGE InstanceSigs #-}+ module Dahdit.Mem   ( MemPtr (..)   , emptyMemPtr@@ -18,14 +20,12 @@ where  import Control.Monad.Primitive (MonadPrim, PrimMonad (..), RealWorld)-import Dahdit.LiftedPrim (LiftedPrim (..), setByteArrayLifted)-import Dahdit.Proxy (proxyFor)-import Dahdit.Sizes (ByteCount (..), staticByteSize)+import Dahdit.Sizes (ByteCount (..)) import Data.ByteString (ByteString) import qualified Data.ByteString.Internal as BSI import Data.ByteString.Short.Internal (ShortByteString (..))-import Data.Coerce (coerce) import Data.Foldable (for_)+import Data.Primitive (Prim (..), sizeOfType) import Data.Primitive.ByteArray   ( ByteArray (..)   , MutableByteArray@@ -34,17 +34,19 @@   , copyByteArrayToPtr   , freezeByteArray   , newByteArray+  , setByteArray   , unsafeFreezeByteArray   , unsafeThawByteArray   )-import Data.Primitive.Ptr (copyPtrToMutableByteArray)+import Data.Primitive.ByteArray.Unaligned (PrimUnaligned, indexUnalignedByteArray, writeUnalignedByteArray)+import Data.Primitive.Ptr (copyPtrToMutableByteArray, indexOffPtr, writeOffPtr) import Data.Vector.Storable (Vector) import qualified Data.Vector.Storable as VS import Data.Vector.Storable.Mutable (IOVector) import qualified Data.Vector.Storable.Mutable as VSM import Data.Word (Word8) import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrBytes, withForeignPtr)-import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Ptr (Ptr, castPtr, plusPtr)  data MemPtr s = MemPtr   { mpForeign :: !(ForeignPtr Word8)@@ -57,7 +59,7 @@ emptyMemPtr = allocPtrMem 0  withMemPtr :: MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a-withMemPtr (MemPtr fp off _) f = withForeignPtr fp (\ptr -> f (plusPtr ptr (coerce off)))+withMemPtr (MemPtr fp off _) f = withForeignPtr fp (\ptr -> f (plusPtr ptr (unByteCount off)))  class (PrimMonad m) => MutableMem r w m | w m -> r where   unsafeThawMem :: r -> m w@@ -76,23 +78,26 @@   unsafeFreezeMem = VS.unsafeFreeze  class (PrimMonad m) => ReadMem r m where-  indexMemInBytes :: (LiftedPrim a) => r -> ByteCount -> m a+  indexMemInBytes :: (Prim a, PrimUnaligned a) => r -> ByteCount -> m a   cloneArrayMemInBytes :: r -> ByteCount -> ByteCount -> m ByteArray  instance (PrimMonad m) => ReadMem ByteArray m where-  indexMemInBytes arr off = pure (indexArrayLiftedInBytes arr off)-  cloneArrayMemInBytes arr off len = pure (cloneByteArray arr (coerce off) (coerce len))+  indexMemInBytes arr off = pure (indexUnalignedByteArray arr (unByteCount off))+  cloneArrayMemInBytes arr off len = pure (cloneByteArray arr (unByteCount off) (unByteCount len))  cloneMemPtr :: MemPtr RealWorld -> ByteCount -> ByteCount -> IO ByteArray cloneMemPtr mem off len = do-  marr <- newByteArray (coerce len)+  marr <- newByteArray (unByteCount len)   withMemPtr mem $ \ptr -> do-    let wptr = plusPtr ptr (coerce off) :: Ptr Word8-    copyPtrToMutableByteArray marr 0 wptr (coerce len)+    let wptr = plusPtr ptr (unByteCount off) :: Ptr Word8+    copyPtrToMutableByteArray marr 0 wptr (unByteCount len)   unsafeFreezeByteArray marr  instance ReadMem (MemPtr RealWorld) IO where-  indexMemInBytes mem off = withMemPtr mem (\ptr -> pure (indexPtrLiftedInBytes ptr off))+  indexMemInBytes :: forall a. (Prim a) => MemPtr RealWorld -> ByteCount -> IO a+  indexMemInBytes mem off = withMemPtr mem $ \ptr ->+    let wptr = plusPtr ptr (unByteCount off)+    in  pure (indexOffPtr wptr 0)   cloneArrayMemInBytes = cloneMemPtr  readSBSMem :: (ReadMem r m) => r -> ByteCount -> ByteCount -> m ShortByteString@@ -104,38 +109,41 @@ viewSBSMem (SBS harr) = ByteArray harr  viewBSMem :: ByteString -> MemPtr RealWorld-viewBSMem bs = let (fp, off, len) = BSI.toForeignPtr bs in MemPtr fp (coerce off) (coerce len)+viewBSMem bs = let (fp, off, len) = BSI.toForeignPtr bs in MemPtr fp (ByteCount off) (ByteCount len)  viewVecMem :: Vector Word8 -> MemPtr RealWorld-viewVecMem vec = let (fp, off, len) = VS.unsafeToForeignPtr vec in MemPtr fp (coerce off) (coerce len)+viewVecMem vec = let (fp, off, len) = VS.unsafeToForeignPtr vec in MemPtr fp (ByteCount off) (ByteCount len)  mutViewVecMem :: IOVector Word8 -> MemPtr RealWorld-mutViewVecMem mvec = let (fp, off, len) = VSM.unsafeToForeignPtr mvec in MemPtr fp (coerce off) (coerce len)+mutViewVecMem mvec = let (fp, off, len) = VSM.unsafeToForeignPtr mvec in MemPtr fp (ByteCount off) (ByteCount len)  class (PrimMonad m) => WriteMem q m where-  writeMemInBytes :: (LiftedPrim a) => a -> q (PrimState m) -> ByteCount -> m ()+  writeMemInBytes :: (Prim a, PrimUnaligned a) => a -> q (PrimState m) -> ByteCount -> m ()   copyArrayMemInBytes :: ByteArray -> ByteCount -> ByteCount -> q (PrimState m) -> ByteCount -> m ()-  setMemInBytes :: (LiftedPrim a) => ByteCount -> a -> q (PrimState m) -> ByteCount -> m ()+  setMemInBytes :: (Prim a, PrimUnaligned a) => ByteCount -> a -> q (PrimState m) -> ByteCount -> m ()  instance (PrimMonad m) => WriteMem MutableByteArray m where-  writeMemInBytes val mem off = writeArrayLiftedInBytes mem off val-  copyArrayMemInBytes arr arrOff arrLen mem off = copyByteArray mem (coerce off) arr (coerce arrOff) (coerce arrLen)-  setMemInBytes len val mem off = setByteArrayLifted mem off len val+  writeMemInBytes val mem off = writeUnalignedByteArray mem (unByteCount off) val+  copyArrayMemInBytes arr arrOff arrLen mem off = copyByteArray mem (unByteCount off) arr (unByteCount arrOff) (unByteCount arrLen)+  setMemInBytes len val mem off = setByteArray mem (unByteCount off) (unByteCount len) val  copyPtr :: (PrimMonad m) => ByteArray -> ByteCount -> ByteCount -> Ptr Word8 -> ByteCount -> m () copyPtr arr arrOff arrLen ptr off =-  let wptr = coerce (plusPtr ptr (coerce off)) :: Ptr Word8-  in  copyByteArrayToPtr wptr arr (coerce arrOff) (coerce arrLen)+  let wptr = castPtr (plusPtr ptr (unByteCount off)) :: Ptr Word8+  in  copyByteArrayToPtr wptr arr (unByteCount arrOff) (unByteCount arrLen) -setPtr :: (PrimMonad m, LiftedPrim a) => ByteCount -> a -> Ptr Word8 -> ByteCount -> m ()-setPtr len val ptr off = do-  let elemSize = staticByteSize (proxyFor val)-      elemLen = div (coerce len) elemSize+setPtr :: forall m a. (PrimMonad m, Prim a) => ByteCount -> a -> Ptr Word8 -> ByteCount -> m ()+setPtr (ByteCount len) val ptr (ByteCount off) = do+  let elemSize = sizeOfType @a+      elemLen = div len elemSize   for_ [0 .. elemLen - 1] $ \pos ->-    writePtrLiftedInBytes ptr (off + pos * elemSize) val+    let wptr = plusPtr ptr (off + pos * elemSize)+    in  writeOffPtr wptr 0 val  instance WriteMem MemPtr IO where-  writeMemInBytes val mem off = withMemPtr mem (\ptr -> writePtrLiftedInBytes ptr off val)+  writeMemInBytes val mem off = withMemPtr mem $ \ptr ->+    let wptr = plusPtr ptr (unByteCount off)+    in  writeOffPtr wptr 0 val   copyArrayMemInBytes arr arrOff arrLen mem off = withMemPtr mem (\ptr -> copyPtr arr arrOff arrLen ptr off)   setMemInBytes len val mem off = withMemPtr mem (\ptr -> setPtr len val ptr off) @@ -144,27 +152,27 @@  withBAMem :: (MonadPrim s m) => ByteCount -> (MutableByteArray s -> m ByteCount) -> m ByteArray withBAMem len use = do-  marr <- newByteArray (coerce len)+  marr <- newByteArray (unByteCount len)   len' <- use marr   if len' == len     then unsafeFreezeByteArray marr-    else freezeByteArray marr 0 (coerce len')+    else freezeByteArray marr 0 (unByteCount len')  withSBSMem :: (MonadPrim s m) => ByteCount -> (MutableByteArray s -> m ByteCount) -> m ShortByteString withSBSMem len use = fmap (\(ByteArray arr) -> SBS arr) (withBAMem len use)  allocPtrMem :: ByteCount -> IO (MemPtr RealWorld) allocPtrMem len = do-  fp <- mallocForeignPtrBytes (coerce len)+  fp <- mallocForeignPtrBytes (unByteCount len)   pure (MemPtr fp 0 len)  freezeVecMem :: MemPtr RealWorld -> ByteCount -> Vector Word8 freezeVecMem (MemPtr fp off _) len =-  VS.unsafeFromForeignPtr fp (coerce off) (coerce (off + len))+  VS.unsafeFromForeignPtr fp (unByteCount off) (unByteCount (off + len))  freezeBSMem :: MemPtr RealWorld -> ByteCount -> ByteString freezeBSMem (MemPtr fp off _) len =-  BSI.fromForeignPtr fp (coerce off) (coerce (off + len))+  BSI.fromForeignPtr fp (unByteCount off) (unByteCount (off + len))  withVecMem :: ByteCount -> (MemPtr RealWorld -> IO ByteCount) -> IO (Vector Word8) withVecMem len use = do

@@ -1,8 +1,11 @@+{-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UndecidableInstances #-} --- | Derived instances rely on the host system being little-endian.--- If it's not, well... some CPP is in order.+-- | Internally, all numbers are represented in little-endian format+-- (since that is what the host endianness is on any arch we'd be using).+-- 'Prim' instances for big endian variants actually do the conversion+-- at read/write time. module Dahdit.Nums   ( Word16LE (..)   , Int16LE (..)@@ -27,141 +30,173 @@   ) where -import Dahdit.Internal (EndianPair (..), swapEndian)-import Data.Bits (Bits)+import Dahdit.ShortWord ()+import Data.Bits (Bits (..), FiniteBits (..))+import Data.Coerce (Coercible, coerce) import Data.Default (Default (..))-import Data.Int (Int16, Int32, Int64)+import Data.Int (Int16, Int32, Int64, Int8)+import Data.Primitive (Prim (..))+import Data.Primitive.ByteArray.Unaligned (PrimUnaligned (..))+import Data.Proxy (Proxy (..)) import Data.ShortWord (Int24, Word24)-import Data.Word (Word16, Word32, Word64)+import Data.Word (Word16, Word32, Word64, Word8, byteSwap16, byteSwap32, byteSwap64)+import GHC.Float (castDoubleToWord64, castFloatToWord32, castWord32ToFloat, castWord64ToDouble)  newtype Word16LE = Word16LE {unWord16LE :: Word16}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)--newtype Int16LE = Int16LE {unInt16LE :: Int16}-  deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Prim, PrimUnaligned, Default, Bits, FiniteBits, Bounded)  newtype Word24LE = Word24LE {unWord24LE :: Word24}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits)--instance Default Word24LE where-  def = 0+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Prim, PrimUnaligned, Default, Bits, FiniteBits, Bounded) -newtype Int24LE = Int24LE {unInt24LE :: Int24}+newtype Word32LE = Word32LE {unWord32LE :: Word32}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Prim, PrimUnaligned, Default, Bits, FiniteBits, Bounded) -instance Default Int24LE where-  def = 0+newtype Word64LE = Word64LE {unWord64LE :: Word64}+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Prim, PrimUnaligned, Default, Bits, FiniteBits, Bounded) -newtype Word32LE = Word32LE {unWord32LE :: Word32}+newtype Int16LE = Int16LE {unInt16LE :: Int16}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Prim, PrimUnaligned, Default, Bits, FiniteBits, Bounded) -newtype Word64LE = Word64LE {unWord64LE :: Word64}+newtype Int24LE = Int24LE {unInt24LE :: Int24}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Prim, PrimUnaligned, Default, Bits, FiniteBits, Bounded)  newtype Int32LE = Int32LE {unInt32LE :: Int32}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Prim, PrimUnaligned, Default, Bits, FiniteBits, Bounded)  newtype Int64LE = Int64LE {unInt64LE :: Int64}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Prim, PrimUnaligned, Default, Bits, FiniteBits, Bounded)  newtype FloatLE = FloatLE {unFloatLE :: Float}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Real, Fractional, Floating, RealFrac, Default)+  deriving newtype (Eq, Ord, Num, Real, Fractional, Floating, PrimUnaligned, RealFrac, Default, Prim)  newtype DoubleLE = DoubleLE {unDoubleLE :: Double}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Real, Fractional, Floating, RealFrac, Default)+  deriving newtype (Eq, Ord, Num, Real, Fractional, Floating, PrimUnaligned, RealFrac, Default, Prim)  newtype Word16BE = Word16BE {unWord16BE :: Word16}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)--newtype Int16BE = Int16BE {unInt16BE :: Int16}-  deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)+  deriving newtype (Eq, Ord, Enum, Num, Real, Integral, Default, Bits, FiniteBits, Bounded)+  deriving (Prim, PrimUnaligned) via (ViaSwapEndian Word16 Word16BE)  newtype Word24BE = Word24BE {unWord24BE :: Word24}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits)--instance Default Word24BE where-  def = 0+  deriving newtype (Eq, Ord, Enum, Num, Real, Integral, Default, Bits, FiniteBits, Bounded)+  deriving (Prim, PrimUnaligned) via (ViaSwapEndian Word24 Word24BE) -newtype Int24BE = Int24BE {unInt24BE :: Int24}+newtype Word32BE = Word32BE {unWord32BE :: Word32}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits)+  deriving newtype (Eq, Ord, Enum, Num, Real, Integral, Default, Bits, FiniteBits, Bounded)+  deriving (Prim, PrimUnaligned) via (ViaSwapEndian Word32 Word32BE) -instance Default Int24BE where-  def = 0+newtype Word64BE = Word64BE {unWord64BE :: Word64}+  deriving stock (Show)+  deriving newtype (Eq, Ord, Enum, Num, Real, Integral, Default, Bits, FiniteBits, Bounded)+  deriving (Prim, PrimUnaligned) via (ViaSwapEndian Word64 Word64BE) -newtype Word32BE = Word32BE {unWord32BE :: Word32}+newtype Int16BE = Int16BE {unInt16BE :: Int16}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)+  deriving newtype (Eq, Ord, Enum, Num, Real, Integral, Default, Bits, FiniteBits, Bounded)+  deriving (Prim, PrimUnaligned) via (ViaSwapEndian Int16 Int16BE) -newtype Int32BE = Int32BE {unInt32BE :: Int32}+newtype Int24BE = Int24BE {unInt24BE :: Int24}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)+  deriving newtype (Eq, Ord, Enum, Num, Real, Integral, Default, Bits, FiniteBits, Bounded)+  deriving (Prim, PrimUnaligned) via (ViaSwapEndian Int24 Int24BE) -newtype Word64BE = Word64BE {unWord64BE :: Word64}+newtype Int32BE = Int32BE {unInt32BE :: Int32}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)+  deriving newtype (Eq, Ord, Enum, Num, Real, Integral, Default, Bits, FiniteBits, Bounded)+  deriving (Prim, PrimUnaligned) via (ViaSwapEndian Int32 Int32BE)  newtype Int64BE = Int64BE {unInt64BE :: Int64}   deriving stock (Show)-  deriving newtype (Eq, Ord, Num, Enum, Bounded, Real, Integral, Bits, Default)+  deriving newtype (Eq, Ord, Enum, Num, Real, Integral, Default, Bits, FiniteBits, Bounded)+  deriving (Prim, PrimUnaligned) via (ViaSwapEndian Int64 Int64BE)  newtype FloatBE = FloatBE {unFloatBE :: Float}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Real, Fractional, Floating, RealFrac, Default)+  deriving (Prim, PrimUnaligned) via (ViaSwapEndian Float FloatBE)  newtype DoubleBE = DoubleBE {unDoubleBE :: Double}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Real, Fractional, Floating, RealFrac, Default)+  deriving (Prim, PrimUnaligned) via (ViaSwapEndian Double DoubleBE) -instance EndianPair 2 Word16LE Word16BE where-  toLittleEndian = Word16LE . swapEndian . unWord16BE-  toBigEndian = Word16BE . swapEndian . unWord16LE+byteSwap24 :: Word24 -> Word24+byteSwap24 = fromIntegral . flip shiftR 8 . byteSwap32 . fromIntegral+{-# INLINE byteSwap24 #-} -instance EndianPair 2 Int16LE Int16BE where-  toLittleEndian = Int16LE . swapEndian . unInt16BE-  toBigEndian = Int16BE . swapEndian . unInt16LE+class (Coercible le x, Coercible be x) => SwapEndian x le be | x -> le be, le -> x be, be -> x le where+  swapEndian :: x -> x -instance EndianPair 3 Word24LE Word24BE where-  toLittleEndian = Word24LE . swapEndian . unWord24BE-  toBigEndian = Word24BE . swapEndian . unWord24LE+instance SwapEndian Word8 Word8 Word8 where+  swapEndian = id -instance EndianPair 3 Int24LE Int24BE where-  toLittleEndian = Int24LE . swapEndian . unInt24BE-  toBigEndian = Int24BE . swapEndian . unInt24LE+instance SwapEndian Int8 Int8 Int8 where+  swapEndian = id -instance EndianPair 4 Word32LE Word32BE where-  toLittleEndian = Word32LE . swapEndian . unWord32BE-  toBigEndian = Word32BE . swapEndian . unWord32LE+instance SwapEndian Word16 Word16LE Word16BE where+  swapEndian = byteSwap16 -instance EndianPair 4 Int32LE Int32BE where-  toLittleEndian = Int32LE . swapEndian . unInt32BE-  toBigEndian = Int32BE . swapEndian . unInt32LE+instance SwapEndian Int16 Int16LE Int16BE where+  swapEndian = fromIntegral . byteSwap16 . fromIntegral -instance EndianPair 8 Word64LE Word64BE where-  toLittleEndian = Word64LE . swapEndian . unWord64BE-  toBigEndian = Word64BE . swapEndian . unWord64LE+instance SwapEndian Word24 Word24LE Word24BE where+  swapEndian = byteSwap24 -instance EndianPair 8 Int64LE Int64BE where-  toLittleEndian = Int64LE . swapEndian . unInt64BE-  toBigEndian = Int64BE . swapEndian . unInt64LE+instance SwapEndian Int24 Int24LE Int24BE where+  swapEndian = fromIntegral . byteSwap24 . fromIntegral -instance EndianPair 4 FloatLE FloatBE where-  toLittleEndian = FloatLE . swapEndian . unFloatBE-  toBigEndian = FloatBE . swapEndian . unFloatLE+instance SwapEndian Word32 Word32LE Word32BE where+  swapEndian = byteSwap32 -instance EndianPair 8 DoubleLE DoubleBE where-  toLittleEndian = DoubleLE . swapEndian . unDoubleBE-  toBigEndian = DoubleBE . swapEndian . unDoubleLE+instance SwapEndian Int32 Int32LE Int32BE where+  swapEndian = fromIntegral . byteSwap32 . fromIntegral++instance SwapEndian Word64 Word64LE Word64BE where+  swapEndian = byteSwap64++instance SwapEndian Int64 Int64LE Int64BE where+  swapEndian = fromIntegral . byteSwap64 . fromIntegral++instance SwapEndian Float FloatLE FloatBE where+  swapEndian = castWord32ToFloat . byteSwap32 . castFloatToWord32++instance SwapEndian Double DoubleLE DoubleBE where+  swapEndian = castWord64ToDouble . byteSwap64 . castDoubleToWord64++newtype ViaSwapEndian x be = ViaSwapEndian {unViaSwapEndian :: be}++instance (Prim x, SwapEndian x le be) => Prim (ViaSwapEndian x be) where+  sizeOfType# _ = sizeOfType# (Proxy @x)+  sizeOf# _ = sizeOf# (undefined :: x)+  alignmentOfType# _ = alignmentOfType# (Proxy @x)+  alignment# _ = alignment# (undefined :: x)+  indexByteArray# ba i = ViaSwapEndian (coerce @x @be (swapEndian (indexByteArray# ba i)))+  readByteArray# ba i s =+    let !(# s', x #) = readByteArray# ba i s+    in  (# s', ViaSwapEndian (coerce @x @be (swapEndian x)) #)+  writeByteArray# ba i (ViaSwapEndian be) = writeByteArray# ba i (swapEndian (coerce @be @x be))+  indexOffAddr# addr i = ViaSwapEndian (coerce @x @be (swapEndian (indexOffAddr# addr i)))+  readOffAddr# addr i s =+    let !(# s', x #) = readOffAddr# addr i s+    in  (# s', ViaSwapEndian (coerce @x @be (swapEndian x)) #)+  writeOffAddr# addr i (ViaSwapEndian be) =+    writeOffAddr# addr i (swapEndian (coerce @be @x be))++instance (PrimUnaligned x, SwapEndian x le be) => PrimUnaligned (ViaSwapEndian x be) where+  indexUnalignedByteArray# ba i = ViaSwapEndian (coerce @x @be (swapEndian (indexUnalignedByteArray# ba i)))+  readUnalignedByteArray# ba i s =+    let !(# s', x #) = readUnalignedByteArray# ba i s+    in  (# s', ViaSwapEndian (coerce @x @be (swapEndian x)) #)+  writeUnalignedByteArray# ba i (ViaSwapEndian be) = writeUnalignedByteArray# ba i (swapEndian (coerce @be @x be))

@@ -45,7 +45,6 @@   , PutStaticSeqF (..)   , ScopeMode (..)   )-import Dahdit.LiftedPrimArray (LiftedPrimArray (..), sizeofLiftedPrimArray) import Dahdit.Mem (ReadMem (..), WriteMem (..), readSBSMem, writeSBSMem) import Dahdit.Nums   ( DoubleBE@@ -70,12 +69,14 @@   , Word64LE   ) import Dahdit.Proxy (proxyForF)-import Dahdit.Sizes (ByteCount (..), ElemCount (..), staticByteSize)+import Dahdit.Sizes (ByteCount (..), ElemCount (..), primByteSizeOf, staticByteSize) import Data.Coerce (coerce) import Data.Foldable (for_, toList) import Data.Int (Int8) import Data.Maybe (fromJust)+import Data.Primitive.ByteArray (ByteArray (..)) import Data.Primitive.MutVar (MutVar, modifyMutVar', newMutVar, readMutVar, writeMutVar)+import Data.Primitive.PrimArray (PrimArray (..), sizeofPrimArray) import Data.Sequence (Seq (..)) import qualified Data.Sequence as Seq import Data.Text (Text)@@ -88,16 +89,16 @@ getStaticSeqSize (GetStaticSeqF ec g _) = staticByteSize (proxyForF g) * coerce ec  getStaticArraySize :: GetStaticArrayF a -> ByteCount-getStaticArraySize (GetStaticArrayF n prox _) = staticByteSize prox * coerce n+getStaticArraySize (GetStaticArrayF n prox _) = primByteSizeOf prox * coerce n  putStaticSeqSize :: PutStaticSeqF a -> ByteCount putStaticSeqSize (PutStaticSeqF n _ _ s _) = staticByteSize (proxyForF s) * coerce n  putStaticArrayElemSize :: PutStaticArrayF a -> ByteCount-putStaticArrayElemSize (PutStaticArrayF _ _ a _) = staticByteSize (proxyForF a)+putStaticArrayElemSize (PutStaticArrayF _ _ zs _) = primByteSizeOf (proxyForF zs)  putStaticArraySize :: PutStaticArrayF a -> ByteCount-putStaticArraySize (PutStaticArrayF n _ a _) = staticByteSize (proxyForF a) * coerce n+putStaticArraySize (PutStaticArrayF n _ zs _) = primByteSizeOf (proxyForF zs) * coerce n  -- Get: @@ -310,8 +311,8 @@ readStaticArray :: (MonadPrim s m, ReadMem r m) => GetStaticArrayF (GetIncM s r m a) -> GetIncM s r m a readStaticArray gsa@(GetStaticArrayF _ _ k) = do   let bc = getStaticArraySize gsa-  sa <- readBytes "static vector" bc (\mem off -> cloneArrayMemInBytes mem off bc)-  k (LiftedPrimArray sa)+  ByteArray ba <- readBytes "static vector" bc (\mem off -> cloneArrayMemInBytes mem off bc)+  k (PrimArray ba)  readLookAhead :: (MonadPrim s m, ReadMem r m) => GetLookAheadF (GetIncM s r m a) -> GetIncM s r m a readLookAhead (GetLookAheadF g k) = do@@ -430,12 +431,12 @@   k  writeStaticArray :: (WriteMem q m) => PutStaticArrayF (PutEff q m a) -> PutEff q m a-writeStaticArray psa@(PutStaticArrayF needElems mz a@(LiftedPrimArray ba) k) = do+writeStaticArray psa@(PutStaticArrayF needElems mz pa@(PrimArray ba) k) = do   let elemSize = putStaticArrayElemSize psa-      haveElems = sizeofLiftedPrimArray a-      useElems = min haveElems (coerce needElems)+      haveElems = ElemCount (sizeofPrimArray pa)+      useElems = min haveElems needElems       useBc = elemSize * coerce useElems-  writeBytes useBc (copyArrayMemInBytes ba 0 useBc)+  writeBytes useBc (copyArrayMemInBytes (ByteArray ba) 0 useBc)   let needBc = putStaticArraySize psa   unless (useBc == needBc) $ do     let extraBc = needBc - useBc

@@ -0,0 +1,232 @@+{-# HLINT ignore "Use const" #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++-- | Exists to give orphan Prim instances to 24-bit integral types.+module Dahdit.ShortWord () where++import Data.Bits (Bits (..), shiftR)+import Data.Default (Default (..))+import Data.Primitive (Prim (..))+import Data.Primitive.ByteArray.Unaligned (PrimUnaligned (..))+import Data.ShortWord (Int24, Word24)+import Data.Word (Word8)+import GHC.Exts (Int (..), Int#, addIntC#, mulIntMayOflo#)++mkWord24 :: Word8 -> Word8 -> Word8 -> Word24+mkWord24 b0 b1 b2 =+  let !w0 = fromIntegral b0+      !w1 = shiftL (fromIntegral b1) 8+      !w2 = shiftL (fromIntegral b2) 16+      !w = w0 .|. w1 .|. w2+  in  w+{-# INLINE mkWord24 #-}++unMkWord24 :: Word24 -> (# Word8, Word8, Word8 #)+unMkWord24 w =+  let !b0 = fromIntegral (w .&. 255)+      !b1 = fromIntegral (shiftR w 8 .&. 255)+      !b2 = fromIntegral (shiftR w 16 .&. 255)+      !bs = (# b0, b1, b2 #)+  in  bs+{-# INLINE unMkWord24 #-}++mkInt24 :: Word8 -> Word8 -> Word8 -> Int24+mkInt24 b0 b1 b2 =+  let !w0 = fromIntegral b0+      !w1 = shiftL (fromIntegral b1) 8+      !w2 = shiftL (fromIntegral b2) 16+      !w = w0 .|. w1 .|. w2+  in  w+{-# INLINE mkInt24 #-}++unMkInt24 :: Int24 -> (# Word8, Word8, Word8 #)+unMkInt24 w =+  let !b0 = fromIntegral (w .&. 255)+      !b1 = fromIntegral (shiftR w 8 .&. 255)+      !b2 = fromIntegral (shiftR w 16 .&. 255)+      !bs = (# b0, b1, b2 #)+  in  bs+{-# INLINE unMkInt24 #-}++k3 :: a -> Int#+k3 = let !(I# i) = 3 in \_ -> i+{-# INLINE k3 #-}++x3 :: Int# -> Int#+x3 =+  let !(I# three) = 3+  in  mulIntMayOflo# three+{-# INLINE x3 #-}++x3p1 :: Int# -> Int#+x3p1 =+  let !(I# three) = 3+      !(I# one) = 1+  in  \i ->+        let !(# x, _ #) = addIntC# one (mulIntMayOflo# three i)+        in  x+{-# INLINE x3p1 #-}++x3p2 :: Int# -> Int#+x3p2 =+  let !(I# three) = 3+      !(I# two) = 2+  in  \i ->+        let !(# x, _ #) = addIntC# two (mulIntMayOflo# three i)+        in  x+{-# INLINE x3p2 #-}++p1 :: Int# -> Int#+p1 =+  let !(I# one) = 1+  in  \i ->+        let !(# x, _ #) = addIntC# one i+        in  x+{-# INLINE p1 #-}++p2 :: Int# -> Int#+p2 =+  let !(I# two) = 2+  in  \i ->+        let !(# x, _ #) = addIntC# two i+        in  x+{-# INLINE p2 #-}++instance Default Word24 where+  def = 0++instance Default Int24 where+  def = 0++instance Prim Word24 where+  sizeOfType# = k3+  sizeOf# = k3+  alignmentOfType# = k3+  alignment# = k3+  indexByteArray# a i =+    let !b0 = indexByteArray# a (x3 i)+        !b1 = indexByteArray# a (x3p1 i)+        !b2 = indexByteArray# a (x3p2 i)+        !w = mkWord24 b0 b1 b2+    in  w+  readByteArray# a i s =+    let !(# s0, b0 #) = readByteArray# a (x3 i) s+        !(# s1, b1 #) = readByteArray# a (x3p1 i) s0+        !(# s2, b2 #) = readByteArray# a (x3p2 i) s1+        !w = mkWord24 b0 b1 b2+        !t = (# s2, w #)+    in  t+  writeByteArray# a i w s =+    let !(# b0, b1, b2 #) = unMkWord24 w+        !s0 = writeByteArray# a (x3 i) b0 s+        !s1 = writeByteArray# a (x3p1 i) b1 s0+        !s2 = writeByteArray# a (x3p2 i) b2 s1+    in  s2+  indexOffAddr# a i =+    let !b0 = indexOffAddr# a (x3 i)+        !b1 = indexOffAddr# a (x3p1 i)+        !b2 = indexOffAddr# a (x3p2 i)+        !w = mkWord24 b0 b1 b2+    in  w+  readOffAddr# a i s =+    let !(# s0, b0 #) = readOffAddr# a (x3 i) s+        !(# s1, b1 #) = readOffAddr# a (x3p1 i) s0+        !(# s2, b2 #) = readOffAddr# a (x3p2 i) s1+        !w = mkWord24 b0 b1 b2+        !t = (# s2, w #)+    in  t+  writeOffAddr# a i w s =+    let !(# b0, b1, b2 #) = unMkWord24 w+        !s0 = writeOffAddr# a (x3 i) b0 s+        !s1 = writeOffAddr# a (x3p1 i) b1 s0+        !s2 = writeOffAddr# a (x3p2 i) b2 s1+    in  s2++instance Prim Int24 where+  sizeOfType# = k3+  sizeOf# = k3+  alignmentOfType# = k3+  alignment# = k3+  indexByteArray# a i =+    let !b0 = indexByteArray# a (x3 i)+        !b1 = indexByteArray# a (x3p1 i)+        !b2 = indexByteArray# a (x3p2 i)+        !w = mkInt24 b0 b1 b2+    in  w+  readByteArray# a i s =+    let !(# s0, b0 #) = readByteArray# a (x3 i) s+        !(# s1, b1 #) = readByteArray# a (x3p1 i) s0+        !(# s2, b2 #) = readByteArray# a (x3p2 i) s1+        !w = mkInt24 b0 b1 b2+        !t = (# s2, w #)+    in  t+  writeByteArray# a i w s =+    let !(# b0, b1, b2 #) = unMkInt24 w+        !s0 = writeByteArray# a (x3 i) b0 s+        !s1 = writeByteArray# a (x3p1 i) b1 s0+        !s2 = writeByteArray# a (x3p2 i) b2 s1+    in  s2+  indexOffAddr# a i =+    let !b0 = indexOffAddr# a (x3 i)+        !b1 = indexOffAddr# a (x3p1 i)+        !b2 = indexOffAddr# a (x3p2 i)+        !w = mkInt24 b0 b1 b2+    in  w+  readOffAddr# a i s =+    let !(# s0, b0 #) = readOffAddr# a (x3 i) s+        !(# s1, b1 #) = readOffAddr# a (x3p1 i) s0+        !(# s2, b2 #) = readOffAddr# a (x3p2 i) s1+        !w = mkInt24 b0 b1 b2+        !t = (# s2, w #)+    in  t+  writeOffAddr# a i w s =+    let !(# b0, b1, b2 #) = unMkInt24 w+        !s0 = writeOffAddr# a (x3 i) b0 s+        !s1 = writeOffAddr# a (x3p1 i) b1 s0+        !s2 = writeOffAddr# a (x3p2 i) b2 s1+    in  s2++instance PrimUnaligned Word24 where+  indexUnalignedByteArray# a i =+    let !b0 = indexByteArray# a i+        !b1 = indexByteArray# a (p1 i)+        !b2 = indexByteArray# a (p2 i)+        !w = mkWord24 b0 b1 b2+    in  w+  readUnalignedByteArray# a i s =+    let !(# s0, b0 #) = readByteArray# a i s+        !(# s1, b1 #) = readByteArray# a (p1 i) s0+        !(# s2, b2 #) = readByteArray# a (p2 i) s1+        !w = mkWord24 b0 b1 b2+        !t = (# s2, w #)+    in  t+  writeUnalignedByteArray# a i w s =+    let !(# b0, b1, b2 #) = unMkWord24 w+        !s0 = writeByteArray# a i b0 s+        !s1 = writeByteArray# a (p1 i) b1 s0+        !s2 = writeByteArray# a (p2 i) b2 s1+    in  s2++instance PrimUnaligned Int24 where+  indexUnalignedByteArray# a i =+    let !b0 = indexByteArray# a i+        !b1 = indexByteArray# a (p1 i)+        !b2 = indexByteArray# a (p2 i)+        !w = mkInt24 b0 b1 b2+    in  w+  readUnalignedByteArray# a i s =+    let !(# s0, b0 #) = readByteArray# a i s+        !(# s1, b1 #) = readByteArray# a (p1 i) s0+        !(# s2, b2 #) = readByteArray# a (p2 i) s1+        !w = mkInt24 b0 b1 b2+        !t = (# s2, w #)+    in  t+  writeUnalignedByteArray# a i w s =+    let !(# b0, b1, b2 #) = unMkInt24 w+        !s0 = writeByteArray# a i b0 s+        !s1 = writeByteArray# a (p1 i) b1 s0+        !s2 = writeByteArray# a (p2 i) b2 s1+    in  s2

@@ -6,10 +6,11 @@   , StaticByteSized (..)   , staticByteSizeFoldable   , byteSizeViaStatic+  , primByteSize+  , primByteSizeOf   ) where -import Dahdit.Internal (ViaEndianPair (..), ViaFromIntegral (..)) import Dahdit.Nums   ( DoubleBE   , DoubleLE@@ -36,6 +37,7 @@ import Data.Coerce (coerce) import Data.Default (Default) import Data.Int (Int16, Int32, Int64, Int8)+import Data.Primitive (Prim, sizeOf, sizeOfType) import Data.Proxy (Proxy (..)) import Data.ShortWord (Int24, Word24) import Data.Word (Word16, Word32, Word64, Word8)@@ -47,12 +49,21 @@   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Default) +instance Bounded ByteCount where+  minBound = 0+  maxBound = ByteCount maxBound+ newtype ElemCount = ElemCount {unElemCount :: Int}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Default) +instance Bounded ElemCount where+  minBound = 0+  maxBound = ElemCount maxBound+ -- StaticByteSized +-- | For types with 'Prim' instances, this will match 'sizeOfType'. class (KnownNat (StaticSize a)) => StaticByteSized a where   type StaticSize a :: Nat   staticByteSize :: Proxy a -> ByteCount@@ -165,36 +176,54 @@   type StaticSize DoubleLE = 8   staticByteSize _ = 8 -instance (StaticByteSized x, n ~ StaticSize x) => StaticByteSized (ViaFromIntegral n x y) where-  type StaticSize (ViaFromIntegral n x y) = n-  staticByteSize _ = staticByteSize (Proxy :: Proxy x)--instance (StaticByteSized le, n ~ StaticSize le) => StaticByteSized (ViaEndianPair n le be) where-  type StaticSize (ViaEndianPair n le be) = n-  staticByteSize _ = staticByteSize (Proxy :: Proxy le)--deriving via (ViaEndianPair 2 Word16LE Word16BE) instance StaticByteSized Word16BE+instance StaticByteSized Word16BE where+  type StaticSize Word16BE = 2+  staticByteSize _ = 2 -deriving via (ViaEndianPair 2 Int16LE Int16BE) instance StaticByteSized Int16BE+instance StaticByteSized Int16BE where+  type StaticSize Int16BE = 2+  staticByteSize _ = 2 -deriving via (ViaEndianPair 3 Word24LE Word24BE) instance StaticByteSized Word24BE+instance StaticByteSized Word24BE where+  type StaticSize Word24BE = 3+  staticByteSize _ = 3 -deriving via (ViaEndianPair 3 Int24LE Int24BE) instance StaticByteSized Int24BE+instance StaticByteSized Int24BE where+  type StaticSize Int24BE = 3+  staticByteSize _ = 3 -deriving via (ViaEndianPair 4 Word32LE Word32BE) instance StaticByteSized Word32BE+instance StaticByteSized Word32BE where+  type StaticSize Word32BE = 4+  staticByteSize _ = 4 -deriving via (ViaEndianPair 4 Int32LE Int32BE) instance StaticByteSized Int32BE+instance StaticByteSized Int32BE where+  type StaticSize Int32BE = 4+  staticByteSize _ = 4 -deriving via (ViaEndianPair 8 Word64LE Word64BE) instance StaticByteSized Word64BE+instance StaticByteSized Word64BE where+  type StaticSize Word64BE = 8+  staticByteSize _ = 8 -deriving via (ViaEndianPair 8 Int64LE Int64BE) instance StaticByteSized Int64BE+instance StaticByteSized Int64BE where+  type StaticSize Int64BE = 8+  staticByteSize _ = 8 -deriving via (ViaEndianPair 4 FloatLE FloatBE) instance StaticByteSized FloatBE+instance StaticByteSized FloatBE where+  type StaticSize FloatBE = 4+  staticByteSize _ = 4 -deriving via (ViaEndianPair 8 DoubleLE DoubleBE) instance StaticByteSized DoubleBE+instance StaticByteSized DoubleBE where+  type StaticSize DoubleBE = 8+  staticByteSize _ = 8  staticByteSizeFoldable :: (Foldable f, StaticByteSized a) => f a -> ByteCount staticByteSizeFoldable fa = staticByteSize (proxyForF fa) * coerce (length fa)  byteSizeViaStatic :: (StaticByteSized a) => a -> ByteCount byteSizeViaStatic = staticByteSize . proxyFor++primByteSize :: (Prim a) => a -> ByteCount+primByteSize = ByteCount . sizeOf++primByteSizeOf :: forall a. (Prim a) => Proxy a -> ByteCount+primByteSizeOf _ = ByteCount (sizeOfType @a)

@@ -29,7 +29,6 @@   , Int32LE   , Int64BE   , Int64LE-  , LiftedPrimArray (..)   , MutBinaryPutTarget (..)   , Proxy (..)   , Put@@ -67,8 +66,8 @@   , getInt64BE   , getInt64LE   , getInt8-  , getLiftedPrimArray   , getLookAhead+  , getPrimArray   , getRemainingSize   , getSeq   , getSkip@@ -86,8 +85,6 @@   , getWord64BE   , getWord64LE   , getWord8-  , lengthLiftedPrimArray-  , liftedPrimArrayFromList   , mutPutTarget   , mutPutTargetOffset   , putByteArray@@ -105,7 +102,7 @@   , putInt64BE   , putInt64LE   , putInt8-  , putLiftedPrimArray+  , putPrimArray   , putSeq   , putStaticArray   , putStaticSeq@@ -120,7 +117,6 @@   , putWord64LE   , putWord8   , runCount-  , sizeofLiftedPrimArray   ) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC@@ -137,6 +133,7 @@   , getSizeofMutableByteArray   , newByteArray   )+import Data.Primitive.PrimArray (primArrayFromList) import Data.Proxy (asProxyTypeOf) import Data.Sequence (Seq (..)) import qualified Data.Sequence as Seq@@ -362,8 +359,12 @@   , GetCase "Int64LE" getInt64LE (Just (8, 0, 0x5DEC6EFD12345678)) [0x78, 0x56, 0x34, 0x12, 0xFD, 0x6E, 0xEC, 0x5D]   , GetCase "Int64BE" getInt64BE (Just (8, 0, 0x5DEC6EFD12345678)) [0x5D, 0xEC, 0x6E, 0xFD, 0x12, 0x34, 0x56, 0x78]   , GetCase "FloatLE" getFloatLE (Just (4, 0, FloatLE (castWord32ToFloat 0x5DEC6EFD))) [0xFD, 0x6E, 0xEC, 0x5D]-  , GetCase "FloatBE" getFloatBE (Just (4, 0, FloatBE (castWord32ToFloat 0x5DEC6EFD))) [0x5D, 0xEC, 0x6E, 0xFD]   , GetCase+      "FloatBE"+      getFloatBE+      (Just (4, 0, FloatBE (castWord32ToFloat 0x5DEC6EFD)))+      [0x5D, 0xEC, 0x6E, 0xFD]+  , GetCase       "DoubleLE"       getDoubleLE       (Just (8, 0, DoubleLE (castWord64ToDouble 0x5DEC6EFD12345678)))@@ -377,12 +378,13 @@   , GetCase "Text" (getText 2) (Just (2, 1, "hi")) [0x68, 0x69, 0xBB]   , GetCase "Two Word8" ((,) <$> getWord8 <*> getWord8) (Just (2, 0, (0x5D, 0xBB))) [0x5D, 0xBB]   , GetCase "Two Word16LE" ((,) <$> getWord16LE <*> getWord16LE) (Just (4, 0, (0x5DEC, 0x4020))) [0xEC, 0x5D, 0x20, 0x40]+  , GetCase "Two Word16BE" ((,) <$> getWord16BE <*> getWord16BE) (Just (4, 0, (0x5DEC, 0x4020))) [0x5D, 0xEC, 0x40, 0x20]   , GetCase "Seq" (getSeq 2 getWord16LE) (Just (4, 0, Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40]   , GetCase "StaticSeq" (getStaticSeq 2 getWord16LE) (Just (4, 0, Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40]   , GetCase       "StaticArray"       (getStaticArray @Word16LE 2)-      (Just (4, 0, liftedPrimArrayFromList [0x5DEC, 0x4020]))+      (Just (4, 0, primArrayFromList [0x5DEC, 0x4020]))       [0xEC, 0x5D, 0x20, 0x40]   , GetCase "DynFoo" (get @DynFoo) (Just (3, 0, DynFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D]   , GetCase "StaFoo" (get @StaFoo) (Just (3, 0, StaFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D]@@ -405,9 +407,9 @@       (Just (3, 1, byteArrayFromList @Word8 [0xFD, 0x6E, 0xEC]))       [0xFD, 0x6E, 0xEC, 0x5D]   , GetCase-      "getLiftedPrimArray"-      (getLiftedPrimArray (Proxy :: Proxy Word16LE) 3)-      (Just (6, 1, liftedPrimArrayFromList @Word16LE [0xFD, 0x6E, 0xEC]))+      "getPrimArray"+      (getPrimArray (Proxy :: Proxy Word16LE) 3)+      (Just (6, 1, primArrayFromList @Word16LE [0xFD, 0x6E, 0xEC]))       [0xFD, 0x00, 0x6E, 0x00, 0xEC, 0x00, 0x5D]   , GetCase "StaBytes" (get @StaBytes) (Just (2, 1, mkStaBytes "hi")) [0x68, 0x69, 0x21]   , GetCase "TagFoo (one)" (get @TagFoo) (Just (2, 0, TagFooOne 7)) [0x00, 0x07]@@ -471,15 +473,15 @@   , PutCase "Two Word16LE" (putWord16LE 0x5DEC *> putWord16LE 0x4020) [0xEC, 0x5D, 0x20, 0x40]   , PutCase "Seq" (putSeq putWord16LE (Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40]   , PutCase "StaticSeq" (putStaticSeq putWord16LE (Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40]-  , PutCase "StaticArray" (putStaticArray @Word16LE (liftedPrimArrayFromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40]+  , PutCase "StaticArray" (putStaticArray @Word16LE (primArrayFromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40]   , PutCase "DynFoo" (put (DynFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D]   , PutCase "StaFoo" (put (StaFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D]   , PutCase "BoolByte True" (put (BoolByte True)) [0x01]   , PutCase "BoolByte False" (put (BoolByte False)) [0x00]   , PutCase "putByteArray" (putByteArray (byteArrayFromList @Word8 [0xFD, 0x6E, 0xEC])) [0xFD, 0x6E, 0xEC]   , PutCase-      "putLiftedPrimArray"-      (putLiftedPrimArray (liftedPrimArrayFromList @Word16LE [0xFD, 0x6E, 0xEC]))+      "putPrimArray"+      (putPrimArray (primArrayFromList @Word16LE [0xFD, 0x6E, 0xEC]))       [0xFD, 0x00, 0x6E, 0x00, 0xEC, 0x00]   , PutCase "StaBytes" (put (mkStaBytes "hi")) [0x68, 0x69]   , PutCase "StaBytes (less)" (put (mkStaBytes "h")) [0x68, 0x00]@@ -522,13 +524,6 @@ testPut :: (BinaryPutTarget z IO, CaseTarget z) => String -> Proxy z -> TestTree testPut n p = testGroup ("put (" ++ n ++ ")") (fmap (runPutCase p) putCases) -testLiftedPrimArray :: TestTree-testLiftedPrimArray = testUnit "liftedPrimArray" $ do-  let arr = LiftedPrimArray (byteArrayFromList @Word8 [0xFD, 0x00, 0x6E, 0x00, 0xEC, 0x00]) :: LiftedPrimArray Word16LE-  liftedPrimArrayFromList [0xFD, 0x6E, 0xEC] === arr-  sizeofLiftedPrimArray arr === 6-  lengthLiftedPrimArray arr === 3- testGetOffset :: (BinaryGetTarget z IO, CaseTarget z) => String -> Proxy z -> TestTree testGetOffset n p = testUnit ("get offset (" ++ n ++ ")") $ do   let buf = [0x12, 0x34, 0x56, 0x78]@@ -669,7 +664,7 @@ testDahdit lim = testGroup "Dahdit" trees  where   trees = baseTrees ++ targetTrees ++ mutTargetTrees-  baseTrees = [testByteSize, testStaticByteSize, testLiftedPrimArray]+  baseTrees = [testByteSize, testStaticByteSize]   targetTrees =     targets >>= \(TargetDef name prox) ->       [ testGet name prox